perm filename PAT.MAC[10X,MRC] blob
sn#426438 filedate 1979-03-17 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00127 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00012 00002 <WRB> fixed DELF bug in RENAME removed 33 => 175 translation
C00025 00003 TITLE PAT - 10/50 Compatibility for Tenex
C00029 00004 SAMFRK LINKP CONPPN SIXPPN DELCHJ CONPPN SPDDEV KI10 DELCHJ CONPPN KI10 SPDDEV DELCHJ MTWEOF CONPPN SIXPPN KI10
C00033 00005 PF A B C D E F G AA BB CC EE FF AC CAC P R.FAIL R.DIRN R.RUNU R.UEXT R.EXIT R.TMPX R.PAGX R.FERR R.KJFN R.RHLT R.SYS L.DBUG L.ONCE L.INDF C.BELL C.FF EOL STDALT
C00036 00006 .JBERR .JBREL .JBPD1 .JBDDT .JBHRL .JBSA .JBSYM .JBFF .JBS41 .JBREN .JBAPR .JBCNI .JBTPC .JBOPC .JBCOR .JBVER .JBDA ASNDF ENTERF INBUFF IOPENF LOOKPF OOPENF PADDF OUTBFF INFIRF OUFIRF INITF
C00038 00007 HASDIR MTADEV DTADEV PTRDEV PTPDEV TTYDEV DSKDEV MY40 MAXERR DDTLOC .S MAXIOL WHEEL OPER MAINT PRIJFN PROJFN PATLOC PATPAG REVECL LODORG NPATPG
C00041 00008 LC PATSPG IOMPGS STATPG STATLC SL.UUO SL.CLI SL.TCL SL.UNI SL.ONC TMPCPG LC TSLOC NTABS
C00044 00009
C00046 00010 CLRTOP PDLL IPDLL NLINKS NRLNKS TSTOP
C00049 00011 EVEC SJBSYM PVLOC KEVEC EVECL CSTMCD PATINI COMPAT COMPT2
C00052 00012 COMPT3 COMPTT ACPTR PATSTK PSISTK
C00054 00013 MRETN2 MRETN MRETNA CSTMRT CPOPJ1 CPOPJ RETZR1 RETZER STOTC1 STOTAC RETM11 RETM1
C00056 00014 MYUU MXCT MMOVE MMOVEM MUR2 MUR1
C00058 00015 MXSIXB
C00061 00016 MCLIT NMCLI CALLTV NPCLI
C00062 00017 UCALL CMRETN UCALLI UCALL1 LIGHTS SWITCH
C00064 00018 FILJFN JAMJFN GETTAB GTTAB NGTTAB
C00066 00019 .GTADR .GTKCT .GTPRV .GTSWP .GTNSW .GTSDT .GTSGN .GTODP .GTPPN .GTPRG .GTTIM .GTTTY .GTCNF GTCNF1 .GTSTS .GTLVD
C00069 00020 DDTIN DDTIN1 DDTIN3 DDTIN2 SETDDT
C00071 00021 UTTCLL TBOUND TTCL2 TTCL2A
C00073 00022 ECHIMM RESMOD TTCL0 TTGET TTXIT
C00075 00023 TTCL0A TTCL0B TTCL1 TTCL15
C00077 00024 TTYBOU TTYBO1 TTYBOF
C00079 00025 TTCL4 TTLP1 TTCL5 TTGET2 TTCL5A
C00081 00026 TTFILL TTFIL2 TTFIL1 TTCNTL TTCNT1
C00084 00027 TTEOL TTBRK1 TTBRK TTBFIN TTBFI3
C00085 00028 DELBF CPSOUT DELCH DELTD NOCHAR RETYPE CRLF CRLFM
C00087 00029 TTYSTS TTYST1 TTYST2 ECHO1 FCOC2 FCOC3 SELFEC DETCHK
C00090 00030 DDTOUT TTCL3 TTCL11 TTCL12 TTCL13 TTCL14 SLOWRT
C00092 00031 TTCL6 TT6NO TTCL7 TTCL10
C00095 00032 SQUEZE SQZ2 SQZ1
C00098 00033 UNSQZE UNSQ2 UNSQ1 GETLIN GETLN1 GETLN2
C00100 00034 APRENB IOERR IOI1 IOER1 IOERQQ
C00104 00035 CTOINT CTOIN1 ABDBRK
C00106 00036 NXPINT NXPBAD
C00108 00037 NXPTRP ATUSER NXPHLT
C00111 00038 NOCTRO OVINT FOVINT PDLINT MINT1
C00113 00039 MEMINT MINT2 INT INSINT INSTRP INST1
C00116 00040 REMAP REMAP3 REMAP1 REMAP2 REMAP4
C00119 00041 RUNTIM RUNTM0 RUNTM1 RUNTM2 RUNTM8 RUNTM3 RUNTM9
C00121 00042 TIMER SLEEP PJOB GETPPN PJOB GETPPN MSTIME MSPDAY
C00123 00043 TMPCOR TMPCO1 TMPCO2 TMPCNX TMPCFE TMPTAB TCNUM
C00127 00044 .TCRFS TMPERF .TCRRF .TCRDF .TCRF1 .TCRF2
C00130 00045 .TCRWF .TCRW1 .TCRW2 .TCRW3 .TCRW4
C00134 00046 .TCRRD .TCRDD .TCRR1 .TCRR2 .TCRR3 TMPFND TMPFN1 TMPFN2 TMPIDT TMPPAG TMPHDR TMPFRE TMPNXT TMPBEG
C00138 00047 GETCHR DEVCHR DEVCH1 GETDEV DEVSIZ DEVTYP DVTYP1
C00141 00048 DVCHR1 DVCHR2 DEVC3 DEVC1 DEVC2 DEVPPN DEVPN1
C00144 00049 CONTTY DEVTBL DEVTTY DEVTB2
C00146 00050 DVTYPT
C00147 00051 UTPCLR DATE NODATE
C00149 00052 GSTATS GST2 UGETST USTATO USTATZ
C00151 00053 USETST UOPEN UINIT UINIT1 UOPEN1 UOPEN2
C00153 00054 UOPEN3 UOPENE
C00156 00055 UOPEN4 NOTMTA UOPEN6 UOPEN7 UOPEN5 PDVNUM
C00159 00056 UINBUF UOUTBF IOBUF UIOBFL
C00162 00057 XPAND
C00163 00058 ULOOKP ULK6 ULK7 ULK1
C00166 00059 ULK3 ULK10 ULK11
C00168 00060 OPENX OPENX7 OPENX5
C00170 00061 OPENX3 OPENX1 OPENX2 OPENX4 OPENX6
C00173 00062 LOOKER LOOKRX LOOKR2 OPENFR ER0 ER4 ER5
C00176 00063 GETLNK LNK1 LNK2 LNKEND LNKEN1 NSF1 NSF2
C00179 00064 GNLNK GNLNK1 GNDONE
C00181 00065 LUKPAR LUKPR5 LUKPR3 LUKPR2 LUKPR4 LUKPR1
C00186 00066 MAKUFD MAKUF1 MAKUF2
C00190 00067 MAKUFE MAKUF3 FLDCNV FLDCN1
C00193 00068 SPDDVT SPDSYS NSPDDV SPDDVN CHKDIR
C00197 00069 UENTER UENT1 ENTR3 ENTER1 ENTR4 ENTR41 ENTRER
C00200 00070 URENME
C00203 00071 RENME1 RENME2 RENME3 RENME4 RENDEL
C00206 00072 PARXCT ENTPAR ENTPR1
C00208 00073 TNXPRT T50PRT PRTTAB
C00211 00074 UCLOSE UCL1K UCL1R UCL2 UCL4 UCL3
C00215 00075 CLOSEI CLOSI2 BUFLP CLOSEO DIRCHK DEV67
C00218 00076 SETUP SIXTO7 SIXT7A SIXT7B SPECCH SETUPG
C00220 00077 UUSETO UUSETI UUSET1
C00222 00078 PTRGET UUGETF DTASET DTAST2
C00225 00079 UMTAPE MTAPE2 MTAPE3 MTAPE1 MTAPE4
C00228 00080 UOUT UIN UIOSK UIOSK1 UINPUT UOUTPT JBKSET
C00229 00081 INN INN3 INN1 INNT INN2
C00232 00082 INN2A INDSPT INDMP INDM1 INDM3
C00234 00083 INDM2 INCML INDM4 INDM4A
C00236 00084 INDMER INDME1 INDME2 INDME3 DTAX3Q
C00239 00085 SETIBF SETIB1 SETIB2
C00241 00086 INTTY INTTY1 INTTD1 INTTY2 INTTEO
C00244 00087 INDON1 INTTY8 INTY8A INTTY9 FILWD INTTY7 TTYBIN TTYBPC INTTDB INTDB1
C00246 00088 INTTDC INTDTD INTDTD INTDC1 INTDC2 DPYDEL DPYDL1 DPYDL2
C00249 00089 INTREP INTRP1 INTRP2 INBYT
C00251 00090 INDSK INDSKB
C00254 00091 OUTMTA INMTA MTALP2 MTALP MTALP1 DMP2 DMP3 EOFCHK DMPOER
C00257 00092 RECCHK RECCH2 MTAERR RECCH1 TAPERR RETRY
C00260 00093 OUTT OUTTN OUTT1 OUTT2 OUTT9
C00263 00094 OUTLST OUTDMP OUTDM1 OUTDM3
C00265 00095 OUDMER OUDME1 OUDME2 OUDME3 OUTDM2 OUTCML OUTDM4 OUDM4L
C00268 00096 OUTTTY OUTTTL OUTTTB OUTTBL OUTTTX OUTASC OUTBYT
C00270 00097 SETOBF SETOB2 SETOB3
C00273 00098 SETOB1
C00274 00099 INIBUF
C00276 00100 URELEA URELR UREL2 IRESET REL0
C00278 00101 RUN GETSEG RUN11B RUN11 RUN11A
C00281 00102 RUN12 RUN12A RUN12B RUN19 GETFAL RUN13
C00285 00103 RUN23 RUN24 RUN21 RUN18
C00288 00104 RUN14 RUN08 RUN09 RUN10 RUN15 RUN20
C00290 00105 SHRINK
C00292 00106 DOGTSG DOGSL1 DOGS1A DOGS1B DOGSN1
C00295 00107 SETVES SETVS1 VESTIG NVSTIG MAKVES MAKVS2 MAKVS1 VESTG2
C00297 00108 URESET RS3 RS3A RS2
C00299 00109 CORE COREUU COREU2 CCLEAR CCLRLP
C00302 00110 FLUSHI COREU3 COREU4 CORU10 COREU6 COREU7 COREU9
C00304 00111 ONCE ONCE1
C00306 00112 NOSTAT
C00309 00113 DEBUG SETCV
C00311 00114 MAKEPF
C00313 00115 GETSHR GSHR1 GSHR3 GSHR2
C00315 00116 SETPSI SPSCTO ONCHNS ALLCHN CLRPSI
C00318 00117 PSITAB COPSIN CCPSIN
C00320 00118 MAKSHR MAKS2
C00321 00119 CSTART CSTRUN CSTNIP
C00323 00120 CSTADR CSTAD1 CSTADX
C00325 00121 CPBOUT BAPOPJ APOPJ ERRARG ERRCHN BUGSTP ERROR ERROR1
C00326 00122 ERROR2 ITRAP ERRINT CSOUT CBOUT
C00328 00123 MCALT NMCAL CALLIT NPCAL
C00329 00124 ILEGAL SETUWP EXIT EXIT2 EXIT4
C00332 00125 EXIT3 EXIT1 KSUIC SUICID ESUIC SUICA SUICB SUICC SETNAM
C00334 00126 LIN2 LIN3 FFF0 FFF ENDFF
C00335 00127 LINIT LIN0 LIN1
C00338 ENDMK
C⊗;
;<WRB> fixed DELF bug in RENAME; removed 33 => 175 translation
;<MRC>PAT.MAC;35 08-SEP-77 20:33:44 TECO'd by MRC
;<MRC>PAT.MAC;33 03-Sep-77 07:30:10 TECO'd by MRC
;<MRC>PAT.MAC;31 08-Aug-77 06:12:01 TECO'd by MRC
;Made TMPCOR UUO a no-op for CCA since apparently CCA's MACRO will not
;win with it.
;At the end of a 30 hour hack session, it all alleges to work.
;<MRC>PAT.MAC;29 07-Aug-77 21:34:44 TECO'd by MRC
;<MRC>PAT.MAC;18 03-Aug-77 22:39:39 TECO'd by MRC
;Continuing to clean up and prettify code
;Inserted CCA features:
;Hairy linking features
;<LIBRARY> added to links
;<MISC> added to links
;<MRC>PAT.MAC;6 29-Jul-77 04:21:10 TECO'd by MRC
;<MRC>PAT.MAC;3 23-Jul-77 00:46:52 TECO'd by MRC
;Lots of code cleanups
;<SOURCES>PAT.MAC;3 14-Feb-77 09:33:37 Edit by Untulis
;Added code for returning system type TENEX
;<SOURCES>PAT.MAC;17 1-Oct-75 11:49:37 Edit by Crossland
;Added ↑R support to Teletype I/O routines to retype current line.
;Merge IMSSS version and SUMEX version including conditional assmbly for
;DELCH JSYS to terminal handling, changes to MTAPE code for IMSSS,
;changes to URESET to unmap file pages before attempting CLOSE.
;<SOURCES>PAT.MAC;16 24-Sep-75 13:51:43 Edit by Crossland
;Fixes to TTYSTS and TTCALL 6 code to allow FORTRAN jobs to be run detached.
;<SOURCES>PAT.MAC;15 13-Aug-75 18:00:40 Edit by Crossland
;Fix to short form RENAME test for delete before test for long form.
;<SOURCES>PAT.MAC;14 14-Jul-75 09:14:44 Edit by Crossland
;Fix to eliminate illegal instruction trap when trying to change protection
;of file that user does not have access to. For FORTRAN. Do not allow change
;of protection only RENAME unless open for write.
;<SOURCES>PAT.MAC;13 27-Jun-75 13:25:30 Edit by Crossland
;Unmap pages if file is closed so it can be reopened for both input
;and output, and add UFD support for ersatz devices.
;<SOURCES>PAT.MAC;12 12-Jun-75 17:18:37 Edit by Crossland
;Fix buffer sycronization problem. IN A,BUFF should do input to BUFF
;not next buffer in string.
;<SOURCES>PAT.MAC;11 29-May-75 10:45:44 Edit by Crossland
;Add image binary, and binary mode for PLT and add USE:
;Fix DVCHR1 to return device number for TTY.
;<SOURCES>PAT.MAC;9 9-May-75 11:27:59 Edit by Crossland
;Take divide by 60 out of SLEEP it already has milliseconds.
;Try to make PSI system a little more liveable.
;Fix APR routine for KA or KI and add KI10 switch.
;<SOURCES>PAT.MAC;8 5-May-75 14:07:33 Edit by Crossland
;Fix DEVPPN and DEVCHR to work for LIB, HLP, NEW etc.
;Fix so that byte size of zero is changed to 36 to prevent /0 in LOOKUP.
;Fix USETI to check GE for end of file so FORTRAN will work.
;Fix buffer use bit so FORTRAN will work.
;<SOURCES>PAT.MAC;7 22-Apr-75 10:05:32 Edit by Crossland
;Merge SUMEX modifications (including DEVCHR on a channel, and extra
;devices) with Xerox PARC's version.
;<SOURCES>PAT.MAC;76 13-Jan-75 17:11:02 Edit by Taft
; Fix up INDSK to return proper count for last buffer.
;<SOURCES>PAT.MAC;75 13-Jan-75 15:59:54 Edit by Taft
; Patch SETOBF to not append nulls to disk files.
;<SOURCES>PAT.MAC;74 13-Jan-75 15:20:11 Edit by Taft
; SOUP merge with BBN changes to date.
;<COMPAT>PAT.MAC;5 29-Dec-74 22:37:52 Edit by Clements
; Fix typo in ENTPAR.
;<COMPAT>PAT.MAC;4 17-Dec-74 19:46:04 Edit by Clements
; DATE75 changes. Localize R.UEXT tests in PARXCT.
; Protection changes. DEVPPN added. .GTLVD added.
; Most of this edit courtesy EAT3.
;<COMPAT>PAT.MAC;1 9-Dec-74 16:36:35 Edit by Calvin
; Bug fixes for 7/74-12/74 were edited
;<SOURCES>PAT.MAC;71 22-Sep-74 18:21:36 Edit by Taft
; Try to suppress reference date update if LOOKUP/ENTER done with
; no buffer headers.
;<SOURCES>PAT.MAC;70 22-Sep-74 17:47:03 Edit by Taft
; Do SOUP merge of BBN & PARC changes to date.
;<COMPAT>PAT.MAC;47 25-Jul-74 14:35:16 Edit by Calvin
; Changed all JOBDAT symbols from JOBxxx to .JBxxx
;<CALVIN>PAT.MAC;2 11-Jul-74 14:14:34 Edit by Calvin
; Changed ENTER & LOOKUP to use GTJFN main string pointer rather than
; default string pointers, patch for reading long files and RESCAN
; UUO also included.
;<CALVIN>PAT.MAC;1 4-Jun-74 10:40:47 Edit by Calvin
; Fixes for magtape, REWIND & reopen for read/write.
;<SOURCES>PAT.MAC;67 19-Jul-74 17:35:19 Edit by Taft
; Fix bug in EXIT code that made continuing from MONRT. not work.
;<SOURCES>PAT.MAC;66 30-May-74 13:55:36 Edit by Taft
; Fix protection glitch -- wrong AC used in TNXPRT
;<SOURCES>PAT.MAC;65 25-May-74 23:11:52 Edit by Taft
; In TMPFND XOR names with TLC not TLZ.
;<SOURCES>PAT.MAC;64 25-May-74 01:11:38 Edit by Taft
; Unmap and close TMPCOR file at EXIT.
;<SOURCES>PAT.MAC;63 25-May-74 00:25:44 Edit by Taft
; Fix switched instruction at ENTR4-1.
;<SOURCES>PAT.MAC;62 21-May-74 02:19:54 Edit by Taft
; Also implement DEVPPN for device SYS.
;<SOURCES>PAT.MAC;61 21-May-74 01:32:40 Edit by Taft
; Fix bug in TMPCOR garbage collector.
; Implement .GTLVD GETTAB for MFD and SYS PPNs.
;<SOURCES>PAT.MAC;60 13-May-74 05:35:41 Edit by Taft
; Implement file protections -- see TNXPRT/T50PRT routines.
; Add routine PARXCT to reference LOOKUP parameters more conveniently.
; Implement extended dates in LOOKUP/ENTER for 1975 and beyond.
; Fix bug in returning file size between 128K and 256K words.
; Implement TMPCOR UUO -- does map operations on file ]TMPCOR[.TMP;T
;<SOURCES>PAT.MAC;55 12-May-74 19:36:14 Edit by Taft
; If OPENF fails because "file busy" try again with thawed access.
;<SOURCES>PAT.MAC;53 12-May-74 18:55:56 Edit by Taft
; Add code to simulate reading of UFDs by first building a UFD in
; the user's own directory, then opening it for reading.
; Change GETPPN and GETTAB to return [1,,dir#] so directory names
; won't make short LOOKUPs look like extended LOOKUPs.
;<COMPAT>PAT.MAC;44 31-Jan-74 16:19:03 Edit by Clements
; Fixes for primary I/O, mostly.
;<COMPAT>PAT.MAC;43 9-Jan-74 11:59:15 Edit by Clements
; More fixes for primary I/O. Make magtape write EOT on output
; CLOSE. Make extended RENAME work for FOROTS. MAKEPF puts file in
; connected directory, not SUBSYS. I/O errors when not in
; PA1050 give error typeout now.
;<COMPAT>PAT.MAC;42 29-Oct-73 18:28:12 Edit by Clements
; Fixes for primary I/O redirection, also read 0's for holey files.
;<COMPAT>PAT.MAC;41 26-Sep-73 15:18:48 Edit by Clements
; Fixed bug in control O giving Illegal Memeory Reference trap
;<COMPAT>PAT.MAC;40 29-Aug-73 16:03:28 Edit by Clements
;<COMPAT>PAT.MAC;39 21-Aug-73 18:12:10 Edit by Clements
; Moved device SYS: entirely into SUBSYS.
;<COMPAT>PAT.MAC;38 26-Jun-73 19:02:02 Edit by Clements
;<COMPAT>PAT.MAC;37 12-Jun-73 13:03:01 Edit by Clements
;<COMPAT>PAT.MAC;36 16-May-73 16:24:49 Edit by Clements
;<COMPAT>PAT.MAC;35 26-Jan-73 18:26:02 Edit by Clements
;<COMPAT>PAT.MAC;34 9-Jan-73 18:49:26 Edit by Clements
;<COMPAT>PAT.MAC;33 28-Nov-72 18:20:16 Edit by Clements
;Fix to DSK dump OUT so non-multiples of 200 padded with 0, not core.
;<COMPAT>PAT.MAC;32 22-Nov-72 12:12:32 Edit by Clements
;<COMPAT>PAT.MAC;31 15-Nov-72 21:10:01 Edit by Clements
;<COMPAT>PAT.MAC;30 14-Nov-72 16:30:46 Edit by Clements
;<COMPAT>PAT.MAC;29 3-Sep-72 20:49:23 Edit by Clements
;<COMPAT>PAT.MAC;28 3-Sep-72 18:50:07 Edit by Clements
;<COMPAT>PAT.MAC;27 9-Aug-72 19:13:48 Edit by Clements
;<COMPAT>PAT.MAC;26 8-Aug-72 14:27:52 Edit by Clements
;<COMPAT>PAT.MAC;25 5-Jul-72 19:16:05 Edit by Clements
TITLE PAT - 10/50 Compatibility for Tenex
IF2 <PRINTX ... is halfway>
SUBTTL Definitions and allocation
PATVER==:134 ;edit number stored in PVLOC
SEARCH STENEX
COMMENT \
This code resides in a high area of user core (currently 700000).
It is loaded from the SSAVE file <SUBSYS>PA1050.SAV by the
monitor whenever a fork executes its first 10/50 UUO (40-77, but not 0).
The first time, entry is via the second location of the entry vector.
Thereafter, 10/50 UUO's result in an immediate transfer to
this code via the first location of the entry vector. When
any 10/50 UUO is executed, the monitor moves location 40 to
MONUUO (specified by fourth word of entry vector), and the return
PC to MONUPC (specified by fifth word of entry vector). This code
interprets the UUO and returns directly to the user program.
This code uses three of the reserved UUO's (42-44) for internal
purposes.
Assembly and loading procedure:
@MACRO ;or whatever to get a MACRO with STENEX in it
*PAT←DSK:PAT
*LOADER!
/S/B/1H/700000H
*PAT$
@START
@
The START after loading causes the code to be moved from its load
location to its running location in high core. The symbol
table is also moved, and the pointer adjusted. An SSAVE file
of pages 700-777 should be made to be used for debugging.
To produce the system file, start at MAKEPF (MAKEPF$G). This will
write a SSAVE file with write protection into the connected directory.
RENAME it into <SUBSYS> to run it.
For debugging compatibility package, first RESET, and GET
the 10/50 program to be used for testing, if any.
Then, merge an SSAVE file (with DDT and symbols) of the
debug version of PAT, type DDT, then DEBUG$G to set up the
compatibility vector, PSI system, and temporary storage.
The third entry of the entry vector is a routine which loads 10/50
.SHR files. These have a format different from .SAV and so
cannot be loaded by the EXEC. To run a 10/50 share file under Tenex,
1. Load the .SHR segment by starting <SUBSYS>PA1050.SAV at 700002
2. Merge the .LOW segment if any with the EXEC MERGE command
3. SSAVE the result
The sixth entry of the entry vector is a routine which converts a
loaded hiseg subsystem to a 10/50 sharable save file,
SSAVEing only pages in 400-677 range with a correctly setup
vestigal job data area. Start <SUBSYS>PA1050.SAV at 700005.
\
;SAMFRK LINKP CONPPN SIXPPN DELCHJ CONPPN SPDDEV KI10 DELCHJ CONPPN KI10 SPDDEV DELCHJ MTWEOF CONPPN SIXPPN KI10
SUBTTL Assembly cruft
SAMFRK==1 ;PAT in same fork with user prog
;This code at present will not work for SAMFRK=0, but there are
;vertiges and partially implemented sections which may be made to
;run that way some day, i.e., with PAT running the 10/50 program as
;an inferior process.
;However, it is quite questionable whether this is really desireable.
;Internal UUO's
OPDEF UMOVE[42B8] ;note - not completely general
OPDEF UMOVEM[43B8] ; e.g., can't UMOVE to EE,FF
OPDEF XCTUU[44B8] ;note all XCT's have same opcode if SAMFRK=1
OPDEF XCTUM[44B8]
OPDEF XCTMU[44B8]
IFNDEF DELCHJ,<DELCHJ==0> ;1 to include code to support DELCH JSYS for
; erasing characters on displays
IFNDEF MTWEOF,<MTWEOF==0> ;1 to prevent writing of EOF on CLOSE
; if nothing written on magtape
IFNDEF CONPPN,<CONPPN==0> ;1 to cause connected PPN instead of LOGIN PPN
; to be returned for CALLI 24 GETPPN
IFNDEF SPDDEV,<SPDDEV==0> ;1 to cause inclusion of all ersatz devices
IFNDEF SIXPPN,<SIXPPN==0> ;1 to cause any PPN with project other than
; 0 or 1 to be considered SIXBIT.
IFNDEF LINKP,<LINKP==0> ;1 to use CCA's hairy links feature
IFNDEF KI10,<KI10==0> ;1 for KI10 APR
IFNDEF STALTP,<STALTP==0> ;1 for code to standardize altmode and escape
; to old DEC altmode (175)
IFNDEF FTSTAT,<FTSTAT==0> ;1 to keep statistics of PA1050 usage
IFNDEF CCA,<CCA==0> ;1 for CCA version
IFNDEF IMSSS,<IMSSS==0> ;1 for IMSSS version
IFNDEF SUMEX,<SUMEX==0> ;1 for SUMEX version
IFNDEF SRIAIC,<SRIAIC==0> ;1 for SRI-AIC version
IF1,<
IFE CCA!IMSSS!SUMEX!SRIAIC,<
PRINTX Standard version
>;IFE CCA!IMSSS!SUMEX!SRIAIC
IFN CCA,<
PRINTX CCA version
LINKP==1
CONPPN==1
SIXPPN==1
>;IFN CCA
IFN SRIAIC,<
PRINTX SRI-ARC version
DELCHJ==1
CONPPN==1
SPDDEV==1
KI10==0
>;IFN SRIAIC
IFN SUMEX,<
PRINTX SUMEX version
DELCHJ==1
CONPPN==1
KI10==1
SPDDEV=1
>;IFN SUMEX
IFN IMSSS,<
PRINTX IMSSS version
DELCHJ==1
MTWEOF==1
CONPPN==1
SIXPPN=1
KI10==1
>;IFN IMSSS
IFN DELCHJ,<
OPDEF DELCH [104000000625] ;display delete character JSYS, IMSSS/SUMEX/SRI only
>;IFN DELCHJ
>;End of pass 1 cruft
;PF A B C D E F G AA BB CC EE FF AC CAC P R.FAIL R.DIRN R.RUNU R.UEXT R.EXIT R.TMPX R.PAGX R.FERR R.KJFN R.RHLT R.SYS L.DBUG L.ONCE L.INDF C.BELL C.FF EOL STDALT
SUBTTL AC's, flags, etc.
;Accumulator definitions
PF=0 ;PAT's flag AC
A=1 ;first AC's are temps and JSYS args
B=2
C=3
D=4
E=5
F=6
G=7
AA=10 ;contains device number during I/O UUO handling
BB=11 ;holds base of I/O channel data block during ...
CC=12 ;holds address of current ring buffer in I/O
EE=13
FF=14
AC=15 ;AC number in 10/50 UUO
CAC=16 ;contents of that AC. Loaded on all UUOs.
P=17
;Flags in AC PF. Left half are permanent (hold over user program)
; Right half are meaningful only within a given UUO, cleared on entry.
R.FAIL==1 ;LOOKUP failure counter in RUN UUO
R.DIRN==2 ;direction of transfer in MTA, USET
R.RUNU==4 ;distinguish RUN UUO from GETSEG UUO
R.UEXT==10 ;extended LOOKUP or ENTER flag
R.EXIT==20 ;on for EXIT 1, ; off for EXIT 0, .
R.TMPX==40 ;TMP extension in LUKPAR
R.PAGX==R.TMPX ;page in HI SEG exists (in DOGTSG routine)
R.FERR==100 ;fatal error. Prevents PMAPing PAT out of existance
R.KJFN==200 ;keep JFN in CLOSE routine.
R.RHLT==400 ;RUN or GETSEG UUO followed by HALT (don't return)
R.SYS==1000 ;RUN UUO from sys, so do SETNM
L.DBUG==1 ;debugging PAT itself
L.ONCE==2 ;have been thru once code
L.INDF==4 ;indicate FF by ↑L requested at EXEC level, so do so.
;Characters referenced symbolically
C.BELL==7 ;bell character
C.FF==14 ;form feed character
EOL==37 ;end of line character
IFN STALTP,<
STDALT==175 ;10/50's standard altmode character
; replaces 033 (ESC) and 176 during simple TTY I/O
>;IFN STALTP
;.JBERR .JBREL .JBPD1 .JBDDT .JBHRL .JBSA .JBSYM .JBFF .JBS41 .JBREN .JBAPR .JBCNI .JBTPC .JBOPC .JBCOR .JBVER .JBDA ASNDF ENTERF INBUFF IOPENF LOOKPF OOPENF PADDF OUTBFF INFIRF OUFIRF INITF
SUBTTL JOBDAT, more flags
;10/50 job data area locations
.JBERR=42 ;error count during CCL sequence
.JBREL=44
.JBPD1=45 ;place users expect to see PC of last UUO
.JBDDT=74
.JBHRL=115
.JBSA=120
.JBSYM=116
.JBFF=121
.JBS41=122
.JBREN=124
.JBAPR=125
.JBCNI=126
.JBTPC=127
.JBOPC=130 ;old PC before ↑C REENTER, ↑C START or ↑C DDT sequence
.JBCOR=133
.JBVER=137
.JBDA==140 ;start of job. End of job data area
;Flags in LH of FLAGWD in channel data tables (CHTABS)
ASNDF==100
ENTERF==200
INBUFF==400
IOPENF==1000
LOOKPF==2000
OOPENF==4000
PADDF==10000 ;not used
OUTBFF==20000
INFIRF==40000
OUFIRF==100000
INITF==200000
;HASDIR MTADEV DTADEV PTRDEV PTPDEV TTYDEV DSKDEV MY40 MAXERR DDTLOC .S MAXIOL WHEEL OPER MAINT PRIJFN PROJFN PATLOC PATPAG REVECL LODORG NPATPG
;Flags for device characteristics
HASDIR==4 ;device has directory
MTADEV==20 ;device is magtape
DTADEV==100 ;device is DECtape
PTRDEV==200 ;device is papertape reader
PTPDEV==400 ;device is papertape punch
TTYDEV==1B32
DSKDEV==200000 ;device is disk
MY40=MONUUO ;UUO word for local UUO's
IFE SAMFRK,<
LOC 41
JSYS MYUU ;local UUO routine
RELOC
>;IFE SMAFRK
MAXERR==10 ;retries when reading magtape
DDTLOC=770000
.S=400000 ;handy abbreviation for sign bit
MAXIOL==4000 ;biggest dump I/O list Tenex will buy
WHEEL==1B18 ;process capability bit
OPER==1B19 ;procees capability bit
MAINT==1B21 ;process capability bit
PRIJFN==100 ;primary input JFN
PROJFN==101 ;primary output JFN
;Get the 10/50 UUO's into the symbol table for debugging PAT
DEFINE REDEF(A)<IRP A,<A=:EXP <A>>>
REDEF <CALL,INIT,CALLI,OPEN,TTCALL,RENAME,IN,OUT,SETSTS,STATO>
REDEF <GETSTS,STATZ,INBUF,OUTBUF,INPUT,OUTPUT,CLOSE,RELEAS>
REDEF <MTAPE,UGETF,USETI,USETO,LOOKUP,ENTER>
;Core assignments
;First for the code.
PATLOC=:700000 ;place where compatibility actually runs
PATPAG==:PATLOC←<-↑D9> ;and as a page number to get thru LOADER
REVECL==4 ;must be .GE. EVECL-.JBHDA, to
;allow space to put EVEC at 700000 even
;rather than 700010.
LODORG==400000 ;where the LOADER will leave "hi segment"
NPATPG==<<TSTOP>←-11>-PATPAG+1 ;how many pages in PAT and TS
;LC PATSPG IOMPGS STATPG STATLC SL.UUO SL.CLI SL.TCL SL.UNI SL.ONC TMPCPG LC TSLOC NTABS
SUBTTL Storage stuff
;Storage allocator for temp storage
DEFINE ALC(NAM,SIZ)
< NAM=:LC
LC==LC+SIZ
>
;Variable storage for PAT
PATSPG==716 ;PAT scratch page, for PMAPs
IOMPGS==720 ;mapped I/O uses 16. pages starting here
IFN FTSTAT,<
STATPG==715 ;page to map in statistics file
STATLC==STATPG←11
SL.UUO=STATLC+200 ;UUO opcode-40
SL.CLI=STATLC+0 ;CALLI number (plus only, room for 200)
SL.TCL=STATLC+300 ;AC of TTCALL
SL.UNI=STATLC+776 ;unimplemented CALLs
SL.ONC=STATLC+777 ;call to ONCE. i.e., count mapping self
>;IFN FTSTAT
TMPCPG==740 ;page to map for simulating TMPCOR UUO
LC==717000 ;temp storage page
TSLOC==LC
ALC CHTABS,0
ALC DEVNAM,1 ;SIXBIT device name from user
ALC JFNTAB,1 ;only needs 7 bits
ALC MAPTAB,1 ;mapping info for disk files
ALC BYTCNT,1 ;byte count for input file
ALC BUFHTB,1 ;output and input buffer headers
ALC FLAGWD,1 ;internal flags,,file status
ALC DEVNUM,1 ;device designator of this device,
; filled in by INIT
ALC FILNAM,1 ;SIXBIT file name from user
ALC EXT,1 ;SIXBIT file ext (3 chars) from user
ALC DIRNUM,1 ;directory number
NTABS==LC-CHTABS
ALC CHTABN,17*NTABS
ALC SAVMOD,1 ;saved Teletype mode
ALC CHTEND,0 ;above here cleared by CALLI 0.
;
;More storage stuff
ALC TTPNT,1 ;pointer,TTCALL input buffer
ALC TTCNT,1 ;byte count,TTCALL input buffer
ALC TTBUF,23 ;TTCALL input buffer
ALC TTLINE,1 ;line present for TTCALL
ALC ERRCNT,1 ;number of magtape errors
ALC DEVNM7,2 ;seven bit device name
ALC FILNM7,3 ;seven bit file name
ALC EXT7,2 ;seven bit extension
ALC DIRNAM,10 ;string space for a directory name
ALC XFILEN,7 ; main string pointer
ALC SEE,1 ;save EE and FF during MYUUO's
ALC SFF,1
ALC FDBB,22
ALC BUFFER,2
ALC JBLOCK,11 ;(9) for JFN arg list
ALC IAC,20 ;AC's on interrupt
ALC MYUUO,1 ;local UUO return
ALC IOBPT,1 ;byte pointer for IN and OUT
ALC IOCNT,1 ;count for IN and OUT
ALC STRNG1,10 ;temp string storage
;also used as stack in CSTART routines
ALC RETSAV,3 ;return saved by pseudointerrupt
ALC CNIWRD,1 ;saves OV EN and FOV EN for APR CONI
ALC MYPPN,1 ;this job's directory number, set by ONCE
ALC MYJOBN,1 ;this job's job number, " "
ALC TMPJFN,1 ;JFN for TMPCOR file if nonzero
;CLRTOP PDLL IPDLL NLINKS NRLNKS TSTOP
;Even more storage stuff
ALC LOTOP,1 ;top of low segment
ALC JBREL,1 ;saved .JBREL
ALC JBHRL,1 ;saved .JBHRL
ALC USRENB,1 ;what user asked for on last APRENB UUO
ALC DMPLST,2 ;MTA I/O by dump commands here
ALC MTDUMP,1 ;temp in dump I/O
ALC SPDELC,1 ;temp in dump I/O
IFN MTWEOF,<
ALC MTAWR,2 ;nonzero if MTAn has been written
>;IFN MTWEOF
ALC TYSTAT,1 ;TTY status (controlling TTY).
; sign is ↑O flag, RH is INIT bits
ALC CSTFLG,1 ;flag to force MRETN to do a START/REENTER
ALC LEVTAB,3 ;PSI level table
ALC CHNTAB,↑D36 ;PSI channel table
CLRTOP==LC-1 ;last location cleared on first entry
ALC FORTY,1 ;place to store contents of 40 at time of call
ALC ACS,20 ;user's AC's at time of UUO.
ALC PFLAGS,1 ;storage for PF AC while user runs.
ALC INPAT,1 ;in PAT if non-0, in user prog if 0
ALC FDBTMP,1 ;room to modify a word of FDB
ALC MONUUO,1 ;copy of monitor 40
ALC MONUPC,1 ;user PC saved by monitor
ALC CSTCOD,1 ;↑C start code: -1=START,
; -2=REENTER, -3=DDT, +N=GOTO n
ALC CSTOPC,1 ;old PC where ↑C CONTINUE would have gone
ALC ITIME1,1 ;system uptime at once
ALC ITIME2,1 ;system TOD in ms at ONCE
;needed for accurate MSTIME code
PDLL==60
ALC PDL,PDLL
IPDLL==20
ALC IPDL,IPDLL ;stack for interrupt level
IFN LINKP,<
ALC LNKRUN,1 ;scratch location for RUN UUO using links
ALC LNKJFN,1 ;JFN for reading links file
ALC LINKS,1 ;switch for reading links file (set to 0 by init)
NLINKS==↑D8 ;number of links allowed
NRLNKS==↑D2 ;number of reserved links
ALC LNKBP,NLINKS ;the table of directories to link to
;set to -1,,LINKST by INIT
ALC LNKST,<NLINKS-NRLNKS>*↑D8 ;string space
>;IFN LINKP
TSTOP=LC ;end of temp storage. Try to keep
; this in one page.
;EVEC SJBSYM PVLOC KEVEC EVECL CSTMCD PATINI COMPAT COMPT2
SUBTTL Entry vector and top-level of UUO handler
HISEG
EVEC=PATLOC ;copy to published location
BLOCK REVECL ;space for EVEC to be put
SJBSYM: BLOCK 1 ;place for LINIT to stash .JBSYM
PVLOC: EXP PATVER ;edit number in RH, patch in LH.
KEVEC: JRST COMPAT ;UUO's normally enter via this
JRST PATINI ;first UUO enters via this
JRST GETSHR ;entry to get SHR file
MONUUO ;mon 40 dumped here on MON UUO
MONUPC ;user PC dumped here on MON UUO
JRST MAKSHR ;make SHR version of subsystem
EXP CCPSIN ;channel for EXEC to PSI on for ↑C REENTER
XWD CSTCOD,CSTOPC ;where to store data for ↑C START sequence
EVECL==.-KEVEC ;length of entry vector
CSTMCD==3 ;max value of CSTCOD known about
;10/50 type UUO's arrive here
PATINI: SETZM PFLAGS ;first time entry. Clear flag word.
IFN LINKP,<
SETZM LINKS ;set up for reading links file
>;IFN LINKP
COMPAT: SKIPE INPAT ;now in PAT?
JRST MYUU ;yes, local UUO
COMPT2: MOVEM 17,ACS+17
MOVEI 17,ACS
BLT 17,ACS+16
MOVE P,PATSTK ;setup local stack
HLLZ PF,PFLAGS ;flags to AC for PAT's flags.
IFN SAMFRK,<
SETOM INPAT
MOVE A,MONUUO
MOVEM A,FORTY ;preserve 40 over MYUUO's
LDB AC,ACPTR ;get AC field of UUO
MOVE CAC,ACS(AC) ;contents of user AC (may be irrelevant)
MOVE A,MONUPC ;get calling PC of user UUO
MOVEM A,.JBPD1 ;put it in 10/50's stack area
PUSH P,A ;and of PAT's stack
>;IFN SAMFRK
IFE SAMFRK,<
LDB AC,ACPTR ;get AC field of UUO
UMOVE CAC,0(AC) ;contents of user AC (may be irrelevent)
PUSH P,MONUPC
>;IFN SAMFRK
TLNN PF,L.ONCE ;first time?
PUSHJ P,ONCE ;yes. Go set up PSI and temp storage
;fall thru
;COMPT3 COMPTT ACPTR PATSTK PSISTK
COMPT3: LDB A,[POINT 9,FORTY,8] ;get UUO number
CAIL A,40 ;small numbers are illegal
CAIL A,100 ;is it a good one?
PUSHJ P,ITRAP ;no good.
IFN FTSTAT,<
AOS SL.UUO(A) ;count usage of the UUO
>;IFN FTSTAT
JRST @COMPTT-40(A) ;we only want to do 40-77
COMPTT: EXP UCALL,UINIT,ITRAP,ITRAP,ITRAP,ITRAP,ITRAP,UCALLI
EXP UOPEN,UTTCLL,ITRAP,ITRAP,ITRAP,URENME,UIN,UOUT
EXP USETST,USTATO,UGETST,USTATZ,UINBUF,UOUTBF,UINPUT,UOUTPT
EXP UCLOSE,URELEA,UMTAPE,UUGETF,UUSETI,UUSETO,ULOOKP,UENTER
ACPTR: POINT 4,FORTY,12
PATSTK: IOWD PDLL,PDL ;local stack
PSISTK: IOWD PDLL,PDL ;stack while on level 1
;MRETN2 MRETN MRETNA CSTMRT CPOPJ1 CPOPJ RETZR1 RETZER STOTC1 STOTAC RETM11 RETM1
SUBTTL Return from 10/50 UUO
MRETN2: AOS (P) ;skip return
MRETN: MOVEM PF,PFLAGS ;save flag AC
POP P,.JBPD1
IFN SAMFRK,<
SETZM INPAT
>;IFN SAMFRK
SKIPE A,CSTFLG ;control-C, START done?
JRST CSTMRT ;yes. Go process it
MRETNA: MOVSI 17,ACS
BLT 17,17
JRSTF @.JBPD1
CSTMRT: HLL A,.JBPD1 ;preserve user's flags
EXCH A,.JBPD1 ;put start adr in return, get usused ret
MOVEM A,.JBOPC ;put the return in OPC for user
SETZM CSTFLG ;clear flag that START done.
JRST MRETNA ;and return to user
CPOPJ1: AOS (P) ;skip return
CPOPJ: POPJ P,
;Common returns from UUO's
RETZR1: TDZA A,A ;clear AC A, then STOTC1 skip return
RETZER: TDZA A,A ;clear AC A, and skip to STOTAC
STOTC1: AOS 0(P) ;set for skip return
STOTAC:
IFN SAMFRK,<
MOVEM A,ACS(AC) ;store the AC for user
>;IFN SAMFRK
IFE SAMFRK,<
UMOVEM A,0(AC) ;store the AC for the user
>;IFE SAMFRK
JRST MRETN ;and return from the UUO
RETM11: AOS 0(P) ;skip return A minus 1
RETM1: MOVNI A,1 ;return a minus one
JRST STOTAC ;to user's AC
;MYUU MXCT MMOVE MMOVEM MUR2 MUR1
SUBTTL Local UUO service
MYUU: MOVEM EE,SEE
MOVEM FF,SFF
IFN SAMFRK,<
MOVE EE,MONUPC
MOVEM EE,MYUUO ;PC to UUO return
>;IFN SAMFRK
LDB EE,[POINT 9,MY40,8]
SUBI EE,42 ;first local UUO
CAIL EE,0 ;local UUO?
CAILE EE,2
JRST [MOVE EE,SEE ;no, must have been ↑C, REENTER
JRST COMPT2] ;treat as user op
JRST @.+1(EE)
EXP MMOVE,MMOVEM,MXCT
MXCT: HRRZ EE,MY40 ;pointer to inst to XCT
MOVEI EE,@(EE) ;compute effective addr
CAIGE EE,20
ADDI EE,ACS ;E in ACs, offset
HLL EE,@MY40
TLZ EE,37 ;flush ind and index
XCT EE
JRST MUR1
AOS MYUUO ;for skip type instructions that did
JRST MUR1
MMOVE: LDB EE,[POINT 4,MY40,12]
HRRZ FF,MY40 ;effective addr
CAIGE FF,20 ;AC?
ADDI FF,ACS ;yes, point to saved AC's
MOVE FF,(FF) ;fetch object
MOVEM FF,(EE) ;put into proper AC
JRST MUR2
MMOVEM: LDB EE,[POINT 4,MY40,12]
MOVE EE,(EE)
HRRZ FF,MY40
CAIGE FF,20
ADDI FF,ACS
MOVEM EE,(FF)
JRST MUR2
MUR2: MOVE FF,SFF
MUR1: MOVE EE,SEE
JRSTF @MYUUO
;MXSIXB
SUBTTL UUO processors for individual UUO's
;10/50 CALL and CALLI tables
;Note that negative CALLIS and 0-55 have SIXBIT CALLs
; while 56 up do not.
MXSIXB==55 ;maximum CALLI which has a SIXBIT arg
DEFINE MCALLI
<CC JAMJFN,JAMJFN
CC FILJFN,FILJFN
CC SQUEZE,SQUEZE
CC UNSQZE,UNSQZE
CC LIGHTS,LIGHTS
>;DEFINE MCALLI
DEFINE PCALLI
<CC RESET,URESET
CC DDTIN,DDTIN
CC SETDDT,SETDDT
CC DDTOUT,DDTOUT
CC DEVCHR,DEVCHR
CC DDTGT
CC GETCHR,GETCHR
CC DDTRL
;10
CC WAIT
CC CORE,CORE
CC EXIT,EXIT
CC UTPCLR,UTPCLR
CC DATE,DATE
CC LOGIN,ILEGAL
CC APRENB,APRENB
CC LOGOUT,EXIT
;20
CC SWITCH,SWITCH
CC REASSI,ILEGAL
CC TIMER,TIMER
CC MSTIME,MSTIME
CC GETPPN,GETPPN
CC TRPSET,ILEGAL
CC TRPJEN,ILEGAL
CC RUNTIM,RUNTIM
;30
CC PJOB,PJOB
CC SLEEP,SLEEP
CC SETPOV
CC PEEK,RETZER
CC GETLIN,GETLIN
CC RUN,RUN
CC SETUWP,SETUWP
CC REMAP,REMAP
;40
CC GETSEG,GETSEG
CC GETTAB,GETTAB
CC SPY
CC SETNAM,SETNAM
CC TMPCOR,TMPCOR
CC DSKCHR
CC SYSSTR
CC JOBSTR
;50
CC STRUUO
CC SYSPHY
CC FRECHN
CC DEVTYP,DEVTYP
CC DEVSTS
CC DEVPPN,DEVPPN
CC SEEK
CC RTTRP
;60
CC LOCK
CC JOBSTS
CC LOCATE
CC WHERE
CC DEVNAM
CC CTLJOB
CC GOBSTR
CC ACTIVA
;70
CC DEACTI
CC HPQ
CC HIBER
CC WAKE
CC CHGPPN
CC SETUUO
CC DEVGEN
CC OTHUSR
;100
CC CHKACC
CC DEVSIZ,DEVSIZ
REPEAT 0,<
CC DAEMON
CC JOBPEK
CC ATTACH
CC DAEFIN
CC FRCUUO
CC DEVLNM
;110
CC PATH.
CC METER.
CC MTCHR.
CC JBSET.
CC POKE.
CC TRMNO.
CC TRMOP.
CC RESDV.
;120
CC DISK.
CC DVRST.
CC DVURS.
>;REPEAT 0
>;DEFINE PCALLI
;MCLIT NMCLI CALLTV NPCLI
SUBTTL CALLI dispatch tables
DEFINE CC (A,B)<
IFB <B>,<
JRST CMRETN ; A unimplemented
>;IFB <B>
IFNB <B>,<
JRST B ; A handler
>;IFNB <B>
>;DEFINE CC
MCLIT:
MCALLI ;transfer to negative CALLI's
NMCLI==.-MCLIT ;number of minus CALLI's
CALLTV: ;address of table entry for CALLI 0
PCALLI ;transfers for positive CALLI'S
NPCLI==.-CALLTV
;UCALL CMRETN UCALLI UCALL1 LIGHTS SWITCH
SUBTTL CALL and CALLI
UCALL: UMOVE A,@FORTY ;arg to CALL in SIXBIT, name of routine
MOVSI B,-<NPCAL+NMCAL> ;length of two SIXBIT tables
CAMN A,CALLIT-NMCAL(B) ;this entry in name table?
JRST [ MOVEI B,-NMCAL(B);yes. Get CALLI number it would be
JRST UCALL1] ;and go to CALLI handler
AOBJN B,.-2 ;no, try next name
CMRETN:
IFN FTSTAT,<
AOS SL.UNI ;count unimplemented CALLs
>;IFN FTSTAT
JRST MRETN ;make a no-op.
UCALLI: HRRZ B,FORTY ;effective addr is the arg
TRNE B,.S ;extend sign into physical bit.
TROA B,1B19 ;it's negative.
TRZ B,1B19 ;it's positive
MOVEI A,NPCLI+NMCLI ;total CALLI length. Catches negative
; out of range too, by half-word arithmetic
CAIGE A,NMCLI(B) ;offset to account for legal negative values
JRST CMRETN ;large arguments are no-ops
UCALL1:
IFN FTSTAT,<
TRNN B,777600 ;only count 0-177 CALLI's
AOS SL.CLI(B) ;in statistics page
>;IFN FTSTAT
JRST @CALLTV(B) ;dispatch
LIGHTS: MOVEI A,.S ;this fork
RPCAP ;get process capabilities
MOVE A,CAC ;get argument to display
TRNE C,WHEEL!OPER!MAINT ;will monitor complain about LITES?
LITES ;no, do it.
JRST MRETN
SWITCH: SWTCH
JRST STOTAC
;FILJFN JAMJFN GETTAB GTTAB NGTTAB
SUBTTL BBN local CALLI's - subject to deletion or change without notice!!
FILJFN: HRRZ A,CAC ;channel number
TRZ A,777760 ;make sure in range
IMULI A,NTABS ;convert to table address
HRRZ A,JFNTAB(A) ;get the JFN now on this file
JUMPE A,STOTAC ;return non-skip if null
JRST STOTC1 ;and skip if okay
JAMJFN: HLRZ B,CAC ;channel arg
ANDI B,17 ;make sure reasonable channel
IMULI B,NTABS ;table address
HRRZ A,JFNTAB(B) ;get old JFN
HRRZM CAC,JFNTAB(B) ;put in new one, hope it works.
JRST STOTC1 ;return skipping with old JFN in AC
GETTAB: HRRZ A,CAC ;get requested table number
CAIL A,NGTTAB ;known to us?
JRST MRETN ;no
HLRZ B,CAC ;yes, get requested entry number
CAIE B,-1 ;this job?
CAIN B,-2 ;this hi seg?
MOVE B,MYJOBN ;yes, plug in job number.
JRST @GTTAB(A) ;go to table handler
GTTAB: EXP .GTSTS,.GTADR,.GTPPN,.GTPRG,.GTTIM,.GTKCT,.GTPRV,.GTSWP
EXP .GTTTY,.GTCNF,.GTNSW,.GTSDT,.GTSGN,.GTODP,.GTLVD
NGTTAB==.-GTTAB
;.GTADR .GTKCT .GTPRV .GTSWP .GTNSW .GTSDT .GTSGN .GTODP .GTPPN .GTPRG .GTTIM .GTTTY .GTCNF GTCNF1 .GTSTS .GTLVD
SUBTTL GETTAB's
;Unimplemented ones:
.GTADR==MRETN
.GTKCT==MRETN
.GTPRV==MRETN
.GTSWP==MRETN
.GTNSW==MRETN
.GTSDT==MRETN
.GTSGN==MRETN
.GTODP==MRETN
.GTPPN: CAME B,MYJOBN ;want own PPN?
JRST [ MOVE A,['JOBDIR'];no, get one user wants
SYSGT
JUMPE B,MRETN
MOVE A,B ;table number
HLL A,CAC ;index = job number
GETAB
JRST MRETN
HLRZ A,A ;only logged in dir
HRLI A,1 ;return 1,,logged in directory
JRST STOTC1]
MOVE A,MYPPN ;return this job's logged in directory
JRST STOTC1
.GTPRG: CAME B,MYJOBN ;want own job?
JRST MRETN ;no, don't bother
GETNM ;get this job's name in SIXBIT
JRST STOTC1 ;and return it.
.GTTIM: CAME B,MYJOBN
JRST MRETN
JOBTM
IMULI A,↑D60
IDIVI A,↑D1000
JRST STOTC1
.GTTTY: MOVE D,B ;move job number out of the way
MOVE A,['JOBTTY']
SYSGT
JUMPE B,MRETN
MOVE A,B
HRL A,D ;job,,table
GETAB
JRST MRETN
HLRE A,A ;terminal number or -1
JRST STOTC1 ;return to user
.GTCNF: CAIN B,17 ;states word?
JRST GTCNF1 ;no, implement more later, now now.
CAIE B,112 ;want system type?
JRST MRETN ;no, implement more later
MOVEI A,3B23 ;say we are on Tenex
JRST STOTC1 ;skip return this answer
GTCNF1: MOVSI A,750501 ;states as supported by PA1050
JRST STOTC1 ;skip return this answer
.GTSTS: CAME B,MYJOBN ;self?
JRST MRETN ;no, not yet implemented
MOVSI A,040004 ;JNA and JLOG
JRST STOTC1 ;skip return
.GTLVD: CAILE B,1 ;first or second entry?
JRST MRETN ;no, not implemented
HRRO B,[[ASCIZ /SYSTEM/]
[ASCIZ /SUBSYS/]](B)
SETZ A,
STDIR ;get "MFD" or "SYS" directory number
PUSHJ P,ERROR ;come on, gotta have those directories.
PUSHJ P,ERROR ; ..
HRLI A,1 ;make them be project 1
JRST STOTC1 ;return and skip
;DDTIN DDTIN1 DDTIN3 DDTIN2 SETDDT
SUBTTL TTY handling
DDTIN: PUSHJ P,NOCTRO ;clear output suppress bit
MOVEI A,100 ;primary input file
RFMOD ;read current TTY status
PUSH P,B ;and save it
TRO B,170300 ;set all wakes, output mode 3
SFMOD ;set the new modes
MOVE D,CAC ;address to store string in user space
HRLI D,440700
MOVEM D,IOBPT
DDTIN1: PUSHJ P,TTYBIN ;get a char from TTY
DDTIN3: XCTMU [IDPB B,IOBPT] ;pointer in M, dest in user space
CAIE B,EOL ;EOL from TTY service?
JRST DDTIN2 ;no
MOVEI B,15 ;yes, convert to CR,LF
XCTMU [DPB B,IOBPT] ;deposit over the EOL
MOVEI B,12 ;LF
JRST DDTIN3
DDTIN2: SIBE ;any more input chars?
JRST DDTIN1 ;yes, go fetch them
MOVEI B,0
XCTMU [IDPB B,IOBPT] ;terminate input with null
POP P,B ;retrieve old TT status
SFMOD ;and reset it
JRST MRETN
SETDDT: UMOVEM CAC,.JBDDT ;set user DDT address
JRST MRETN
;UTTCLL TBOUND TTCL2 TTCL2A
SUBTTL TTCALL and other terminal handling UUO's
;TTCALL UUO, dispatch by AC field.
;AC values are:
;0=INCHRW 1=OUTCHR 2=INCHRS 3=OUTSTR 4=INCHWL 5=INCHSL 6=GETLCH
;7=SETLCH 10=RESCAN 11=CLRBFI 12=CLRBFO 13=SKPINC 14=SKPINL
;15=IONEOU 16=CPOPJ 17=CPOPJ
UTTCLL: MOVE E,TYSTAT ;carry around TTY status bits in E
IFN FTSTAT,<
AOS SL.TCL(AC)> ;count the type of TTCALL
JRST @.+1(AC)
EXP TTCL0,TTCL1,TTCL2,TTCL3,TTCL4,TTCL5,TTCL6,TTCL7
EXP TTCL10,TTCL11,TTCL12,TTCL13,TTCL14,TTCL15
EXP MRETN,MRETN ;16 and 17 not implemented
TBOUND: MOVEI A,100
HRRZ C,FORTY ;arg must not be between 20 and 114
CAIGE C,115
CAIGE C,20
POPJ P,
PUSHJ P,ERRARG
TTCL2: PUSHJ P,NOCTRO ;defeat control-O
PUSHJ P,TBOUND
PUSHJ P,ECHIMM ;set echo immediate
SKIPG TTCNT ;any chars in my buffer?
JRST TTCL2A ;no, try monitor buffer
AOS (P) ;yes, successful skip return
JRST TTGET ;go get it
TTCL2A: SIBE ;no, any in monitor buffer?
AOSA 0(P) ;successful return
JRST SLOWRT ;nothing there, return slowly.
JRST TTCL0A
;ECHIMM RESMOD TTCL0 TTGET TTXIT
ECHIMM: RFMOD
MOVEM B,SAVMOD ;previous mode will be restored on
TRZN B,3B25 ;clear echo bits, was no echo?
POPJ P, ;yes, don't change
TRO B,1B25 ;set echo mode to immediate for TTY
SFMOD
POPJ P,
RESMOD: SKIPN SAVMOD ;restore saved echo mode?
POPJ P, ;no, nothing there
RFMOD
XOR B,SAVMOD ;restore echo mode bits
TRZ B,3B25
XOR B,SAVMOD
SETZM SAVMOD ;only do it once
SFMOD
POPJ P,
TTCL0: PUSHJ P,NOCTRO ;clear control-O flag
PUSHJ P,TBOUND ;legal destination?
PUSHJ P,RESMOD ;restore saved echo mode
TTGET: SOSGE TTCNT ;any chars in buffer?
JRST TTCL0A ;nothing there - go back to refill
ILDB B,TTPNT
TTXIT: UMOVEM B,(C) ;return the char
JRST MRETN
;TTCL0A TTCL0B TTCL1 TTCL15
TTCL0A: RFMOD
TRO B,17B23!3B29 ;break on anything
SFMOD
MOVE E,TYSTAT ;get status bits of TTY
PUSH P,C ;preserve arg
PUSHJ P,TTYST2 ;set echo control
PUSHJ P,TTBFI3 ;set up the TTCALL buffer
POP P,C ;restore arg
PUSHJ P,TTYBIN ;get a char from TTY
TRNE E,1B29 ;full char set mode?
JRST TTCL0B ;yes, don't crunch altmodes
IFN STALTP,<
CAIE B,176 ;old altmode
CAIN B,33 ;ESCAPE?
MOVEI B,STDALT ;yes, make standard (ha ha) ALTMODE
>;IFN STALTP
TTCL0B: CAIE B,EOL ;end of line?
JRST TTXIT ;no - feed it to user
PUSHJ P,TTEOL ;yes, convert to CR-LF
JRST TTGET
TTCL1: MOVEI A,101 ;output a single char
UMOVE B,@FORTY
PUSHJ P,TTYBOU ;output character, checking ↑L, ↑O
JRST MRETN
TTCL15: MOVEI A,101 ;output one image character.
RFMOD ;so switch TTY to binary to do it.
PUSH P,B ;save previous mode
TRZ B,3B29 ;binary
SFMOD
UMOVE B,@FORTY ;get user's character
PUSHJ P,TTYBO1 ;send it
POP P,B ;restore previous mode
SFMOD ; ..
JRST MRETN ;done with this TTCALL
;TTYBOU TTYBO1 TTYBOF
;Routine to output a byte to TTY, JFN in A, byte in B.
TTYBOU: SKIPGE TYSTAT ;control O flag (output suppress) on?
POPJ P, ;yes, don't output
CAIN A,100 ;output to primary input somehow?
MOVEI A,101 ;yes, make it output.
CAIN B,C.FF ;formfeed?
JRST TTYBOF ;yes, go check indicate flag
CAIN B,EOL ;want to get the real "037" out?
JRST [ RFMOD ;yes, switch to binary.
PUSH P,B
TRZ B,3B29
SFMOD
MOVEI B,EOL
PUSHJ P,TTYBO1
POP P,B
SFMOD
POPJ P,] ;end of send EOL in binary
;else fall into outputter
TTYBO1: BOUT ;ordinary, output it.
POPJ P, ;and return
TTYBOF: TLNN PF,L.INDF ;formfeed, send or indicate?
JRST TTYBO1 ;send.
HRROI B,[ASCIZ /↑L
/] ;indication, note clobbers B and C
MOVEI C,0 ;string length counter
SOUT ;string to TTY (JFN in A)
POPJ P, ;and return
;TTCL4 TTLP1 TTCL5 TTGET2 TTCL5A
TTCL4: PUSHJ P,NOCTRO ;clear control-O flag
PUSHJ P,TBOUND ;legal destination?
PUSHJ P,RESMOD ;restore saved echo mode
SKIPN TTCNT
PUSHJ P,TTBFIN
SKIPE TTLINE ;is there a line there?
JRST TTGET2 ;yes, go get it
TTLP1: PUSHJ P,TTFIL2 ;try to fill buffer
SKIPL TTLINE ;now do we have a line?
JRST TTLP1 ;no, try again
JRST TTGET2 ;now there is a line there
TTCL5: PUSHJ P,NOCTRO ;clear control-O flag
PUSHJ P,TBOUND
SKIPN TTCNT
PUSHJ P,TTBFIN
SKIPL TTLINE ;is there a line?
PUSHJ P,TTFILL ;no, try to get one
SKIPL TTLINE ;now is there one?
JRST TTCL5A ;no, give up and nonskip return
AOS 0(P) ;yes, successful skip return
TTGET2: ILDB B,TTPNT
UMOVEM B,(C) ;give char to user
SOSLE TTCNT ;count it
JRST MRETN ;more left
SETZM TTLINE ;out of chars
PUSHJ P,TTBFIN ;init buffer
JRST MRETN
TTCL5A: PUSHJ P,ECHIMM ;set echo mode to immediate
JRST SLOWRT ;and return (slowly) to user
;TTFILL TTFIL2 TTFIL1 TTCNTL TTCNT1
TTFILL: MOVEI A,100
SIBE ;something in input buffer?
SKIPA ;yes
POPJ P, ;no, forget it
TTFIL2: PUSHJ P,TTYBIN ;do a BIN from TTY
CAIL B,40 ;control?
CAILE B,174 ;ALTMODE or RUBOUT?
JRST TTCNTL ;yes
TTFIL1: IDPB B,TTPNT ;no, stuff it
AOS TTCNT
JRST TTFILL ;and get more
TTCNTL: TRNE E,1B29 ;in FCS mode?
JRST TTCNT1 ;yes, don't crunch altmodes or grab ctls
IFN STALTP,<
CAIE B,176 ;old ALTMODE?
CAIN B,33 ;or ESCAPE?
MOVEI B,STDALT ;yes, convert to 10/50 ALTMODE (ha ha ha)
>;IFN STALTP
CAIE B,177 ;RUBOUT character?
CAIN B,"A"-100 ;char delete?
JRST DELCH ;yes
CAIE B,"U"-100 ;control-U (10/50 buffer clear)?
CAIN B,"X"-100 ;clear buffer?
JRST DELBF ;yes
CAIN B,"R"-100 ;repeat line?
JRST RETYPE
TTCNT1: CAIN B,EOL ;end of line?
JRST TTEOL ;yes
IDPB B,TTPNT ;fairly ordinary control char
AOS TTCNT
CAIE B,C.BELL ;bell?
IFN STALTP,<
CAIL B,175 ;ALTMODE or RUBOUT?
>;IFN STALTP
IFE STALTP,<
CAIN B,177 ;RUBOUT?
>;IFE STALTP
JRST TTBRK ;yes
CAIE B,"U"-100 ;control-U in FCS?
CAIN B,"Z"-100 ;end of file?
JRST TTBRK1 ;yes
CAIN B,"R"-100 ;control-R in FCS?
JRST TTBRK1
CAIN B,33 ;ESCAPE?
JRST TTBRK ;yes, break character
CAIGE B,15 ;vertical format control?
CAIGE B,12
JRST TTFILL ;non-format control - keep filling
JRST TTBRK ;some format character
;TTEOL TTBRK1 TTBRK TTBFIN TTBFI3
TTEOL: MOVEI B,15 ;carriage return
IDPB B,TTPNT
AOS TTCNT
MOVEI B,12 ;line feed
IDPB B,TTPNT
AOS TTCNT
JRST TTBRK ;go back to user
TTBRK1: PUSHJ P,CRLF ;CRLF for ↑Z, ↑U, ↑R characters
TTBRK: MOVE B,[POINT 7,TTBUF] ;format control - break to user
MOVEM B,TTPNT
SETOM TTLINE ;now there is a line in my buffer
POPJ P,
TTBFIN: MOVEI A,100
MOVE E,TYSTAT ;get TTY flags
PUSH P,C ;save AC
PUSHJ P,TTYST1 ;set TTY status
POP P,C ;restore AC
TTBFI3: MOVE B,[POINT 7,TTBUF]
MOVEM B,TTPNT
SETZM TTCNT
SETZM TTLINE
POPJ P,
;DELBF CPSOUT DELCH DELTD NOCHAR RETYPE CRLF CRLFM
DELBF: PUSHJ P,TTBFIN ;reinit buffer
HRROI A,[ASCIZ/
/] ;↑U should terpri
CPSOUT: PSOUT
JRST TTFILL
DELCH: SKIPG TTCNT ;something to delete?
JRST NOCHAR ;no
PUSH P,1
IFN DELCHJ,<
MOVEI 1,101 ;primary output
DELCH
JFCL ;JFN not terminal?
JRST DELTD ;nothing on this line
JRST DELTD ;deleted and accounted
;plus 4 for non-dpy...
>;DELCHJ
MOVEI 1,"\"
PBOUT
LDB 1,TTPNT ;type back char to be deleted
PBOUT
IFN DELCHJ,<
DELTD: ;here after DELCH above
>;DELCHJ
POP P,1
SOS TTCNT ;decrement count
MOVE B,TTPNT ;and pointer
ADD B,[XWD 70000,0]
TLNE B,400000
SUB B,[XWD 340000,1] ;back up a word
MOVEM B,TTPNT
JRST TTFILL ;and keep filling buffer
NOCHAR: PUSH P,1
MOVEI 1,7 ;bell
PBOUT ;ring it
POP P,1
JRST TTFILL
RETYPE: PUSHJ P,CRLF
SETZ B,
MOVE A,TTPNT
IDPB B,A ;make ASCIZ string
HRROI A,TTBUF ;put out buffer
JRST CPSOUT
CRLF: PUSH P,A ;type out a CRLF, save A
HRROI A,CRLFM
PSOUT
POP P,A
POPJ P, ;and return
CRLFM: ASCIZ /
/
;TTYSTS TTYST1 TTYST2 ECHO1 FCOC2 FCOC3 SELFEC DETCHK
;Set device status for TTY
TTYSTS: MOVE E,FLAGWD(BB)
MOVE A,JFNTAB(BB)
TTYST1: PUSHJ P,DETCHK ;is job detached?
POPJ P, ;yes return
RFMOD ;no, read terminal mode
TRZ B,17B23!3B25!3B29 ;clear wakeup, echo, mode
TRNN E,1B28 ;suppress echo requested by user?
TRO B,2B25 ;no, allow echoing
TRO B,14B23!3B29 ;controls, ASCII mode with no output xlation
SFMOD ;set this mode word
TTYST2: TRNE E,1B27 ;user want ALT $ suppressed?
JRST ECHO1 ;yes, go get different bits
MOVE B,FCOC2 ;get usual char output words.
TLNE PF,L.INDF ;user want ↑L indicated?
TRC B,3B25 ;yes, change bits for ↑L from 2 to 1
MOVE C,FCOC3 ;both control words
TRNE E,1B29 ;FCS mode?
TLZ C,(3B7) ;yes, clobber echoing of ↑U graphic.
SFCOC ;set control output modes
POPJ P, ;return from TTYSTS/TTYST2
ECHO1: MOVE B,SELFEC ;echo controls as self
MOVE C,B ;all of them
SFCOC ;to monitor
POPJ P, ;return
;Echo bytes for control characters:
; 00 means ignore, discard.
; 01 means indicate by ↑X
; 10 means send and acct (sim if necessary only)
; 11 means simulate and acct
; @,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q
FCOC2: BYTE (2) 0,0,1,1,1,1,1,2,2,2,2,2,2,2,1,1,1,1
; R,S,T,U,V,W,X,Y,Z,[ \ ] ↑ ←
FCOC3: BYTE (2) 1,1,1,1,1,1,1,1,1,3,1,1,1,2
SELFEC: BYTE (2) 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2
;Check to see if job is detached.
DETCHK: PUSH P,D ;save ACs
PUSH P,C
PUSH P,B
PUSH P,A
GJINF ;get job info.
POP P,A ;restore ACs
POP P,B
POP P,C
SKIPL D ;is job detached
AOS -1(P) ;no
POP P,D
POPJ P,
;DDTOUT TTCL3 TTCL11 TTCL12 TTCL13 TTCL14 SLOWRT
DDTOUT: MOVE D,CAC ;address of string to type out
TLOA D,-1 ;make string pointer, skip to output
TTCL3: HRRO D,FORTY
TRNN D,-20 ;in the users AC's?
HRRI D,ACS(D) ;yes, move pointer
MOVEI A,101 ;JFN for "TTY"
HRLI D,440700 ;parse the string into bytes
ILDB B,D ;get a byte
JUMPE B,MRETN ;quit on first null
PUSHJ P,TTYBOU ;output, checking ↑O, indicate ↑L
JRST .-3 ;loop till end of string
TTCL11: MOVEI A,100 ;clear input buffer
CFIBF
PUSHJ P,TTBFIN ;and clear my buffer
JRST MRETN
TTCL12: MOVEI A,101 ;clear output buffer
CFOBF
JRST MRETN
TTCL13: PUSHJ P,NOCTRO ;clear control-O flag
MOVEI A,100 ;skip if char avail for input
SKIPG TTCNT ;any char in my buffer?
SIBE
JRST MRETN2 ;yes, skip return.
JRST SLOWRT ;no, slow return.
TTCL14: PUSHJ P,NOCTRO ;clear control-O flag
SKIPL TTLINE ;do I have a line?
PUSHJ P,TTFILL ;no, try to get one
SKIPE TTLINE ;now do I have one?
JRST MRETN2 ;yes, success, skip return
SLOWRT:
REPEAT 0,<;Taken out because of DEC DDT TTCALL during word search
MOVEI A,↑D100 ;in case of dump SKPINC/JRST .-1
DISMS ;slow it down a little
>;REPEAT 0
JRST MRETN
;TTCL6 TT6NO TTCL7 TTCL10
TTCL6: PUSHJ P,TBOUND
UMOVE B,0(C)
SETZ C,
CAIGE B,0 ;control TTY?
PUSHJ P,DETCHK ;yes, is job detached?
JRST TT6NO ;yes, return a zero
PUSH P,A ;save JFN incase of redirect
DVCHR ;get the true poor on TTY
POP P,A ;use JFN not device designator
HRLI C,0 ;clear left half; just line number
RFMOD ;get terminal characteristics
TRNE B,3B33 ;shuffle between Tenex and 10/50 bits
TLO C,(1B5) ;half duplex bit
TLNE B,(1B2) ;tabs?
TLO C,(1B14) ;tabs.
TLNE B,(1B3) ;lower case?
TLO C,(1B13) ;lower case.
TRNE E,1B28 ;no echo in INIT flags?
TLO C,(1B15) ;yes.
TT6NO: UMOVEM C,@FORTY ;return the answer to user
JRST MRETN ;end of UUO
TTCL7: PUSHJ P,TBOUND ;check argument
RFMOD ;get characteristics of terminal
UMOVE C,0(C) ;get user's desired bits
TLNE C,(1B13) ;want lower case?
TLOA B,(1B3) ;yes.
TLZ B,(1B3) ;no.
TLNE C,(1B14) ;want tabs?
TLOA B,(1B2) ;yes
TLZ B,(1B2) ;no
TRO B,2B25 ;assume echo
TRZ E,1B28 ;clear no-echo in INIT
;*** This ain't right!!!! ***
TLNE C,(1B15) ;want echo?
TRO E,1B28 ;yes, turn it on.
MOVEM E,TYSTAT ;save that decision
TRNE E,1B28 ;echo decided on?
TRZ B,3B25 ;no, clear in Tenex mode.
SFMOD ;give to monitor
JRST MRETN ;and return from TTCALL 7
TTCL10: PUSHJ P,TTBFIN
PUSHJ P,TTEOL
JRST MRETN
;SQUEZE SQZ2 SQZ1
SUBTTL Directory name hacking frobs
;SQUEZE and UNSQZE are really string-to-directory and
;directory-to-string
;It is assumed that SQUEZE is used only where a cusp has
;accumulated a word of sixbit for a proj-prog designator
;SQUEZE converts it to a directory number which can be used
;in LOOKUP and ENTER.
;The word of sixbit can be either: (1) six characters which
;should uniquely identify a directorr, or (2) six digits specifying
;a directory number which will be converted to binary and returned.
SQUEZE: MOVE B,CAC ;sixbit to make into directory number
MOVE A,[POINT 7,STRNG1,-1]
SETZB F,D ;accumulate sum in F, flag chars in D
MOVEI E,6 ;count six chars
SQZ2: SETZ C,
ROTC B,6 ;get char
JUMPE C,SQZ1 ;ignore blanks
ADDI C,40 ;make it ASCII from SIXBIT
IDPB C,A ;put in string for STDIR
CAIL C,"0" ;digit?
CAILE C,"9"
AOJA D,SQZ1 ;no, flag non-digit
LSH F,3 ;accumulate octal sum
ADDI F,-20(C)
SQZ1: SOJG E,SQZ2
JUMPE D,[ MOVE A,F ;only digits encountered, return sum
JRST STOTAC]
HRLZI A,400000 ;try to match
HRROI B,STRNG1
STDIR ;get directory number from string
JFCL ;ambiguous or
MOVEI A,0 ;no such match, give back a zero
HRRZ A,A ;directory # only (no bits)
JRST STOTAC ;return answer in AC
;UNSQZE UNSQ2 UNSQ1 GETLIN GETLN1 GETLN2
;UNSQZE converts a directory number to a word of sixbit containing
;the first six characters of the directory name
UNSQZE: HRRZ B,CAC ;get directory number
MOVEI C,0 ;where sixbit will go
HRROI A,STRNG1 ;temp location for the 7-bit string
DIRST ;get the directory name string
JRST UNSQ1 ;wrong number, return 0
MOVE A,[POINT 7,STRNG1,-1]
MOVE B,[POINT 6,C,-1] ;accumulate sixbit in AC3
MOVEI F,6 ;only six chars
UNSQ2: ILDB D,A
JUMPE D,UNSQ1 ;null marks end of string
SUBI D,40 ;ASCII back to SIXBIT
IDPB D,B
SOJG F,UNSQ2
UNSQ1: MOVE A,C ;answer
JRST STOTAC ;return it to usrR
GETLIN: HRROI A,[ASCIZ /TTY/]
STDEV ;device code in 2
PUSHJ P,ERROR
MOVE A,[POINT 7,E]
DEVST
PUSHJ P,ERROR
MOVE A,[POINT 6,B]
SETZ B, ;to sixbit in B
MOVEI C,6 ;counter for sixbit conversion
MOVE D,[POINT 7,E] ;pointer to string
GETLN1: ILDB G,D ;get next 7 bits
JUMPE G,GETLN2 ;zero means done
SUBI G,40 ;to sixbit
IDPB G,A ;and into result
SOJG C,GETLN1 ;decrement and test counter
GETLN2: MOVE A,B ;answer from B
JRST STOTAC ;to user's AC
;APRENB IOERR IOI1 IOER1 IOERQQ
SUBTTL Trap handling
;APR traps enable
; user call is
; MOVEI AC,BITS
; CALLI AC,16
;
;where bits are 1B18 for repeated traps (except CLK)
; 1B19 for PDLOV, 1B22 for Ill Mem Ref, 1B23 for NXM
; 1B26 for CLOCK (not yet supported), 1B29 for FOV, 1B32 for AROV
APRENB:
; MOVSI A,400000 ;this fork ;This code is duplicated in
; MOVE B,[XWD LEVTAB,CHNTAB] ;SETPSI routine
; SIR ;new pseudointerrupt channels
MOVEM CAC,USRENB ;save for later reference
IFE KI10,<
LSH CAC,1 ;match up with enable flags
ANDI CAC,220 ;for OV and FOV
MOVEM CAC,CNIWRD ;and remember for APR CONI
>;IFE KI10
IFN KI10,<
SETZ A, ;clear CONI word
TRNE CAC,1B20 ;is parity error enabled?
TRO A,1B24 ;indicate parity error enabled
TRNE CAC,1B25 ;is clock enabled?
TRO A,1B26 ;yes, say so
MOVEM A,CNIWRD ;and remember for APR CONI
>;IFN KI10
PUSHJ P,SETPSI ;set up PSI as indicated by USRENB
; EIR ;enable interrupt system ;done in SETPSI
JRST MRETN
;I/O error - this does not get passed to the user via CNIWRD;
; rather it causes I/O error bits to be set in the file status word
IOERR: SKIPL INPAT
JRST IOERQQ ;not my error, give typeout.
MOVEM 7,IAC+7 ;save some AC's
MOVEI 7,IAC
BLT 7,IAC+6
MOVEI 7,1B19+1B20 ;prepare to set these bits in status word
IOI1: MOVE 1,BB ;extensive check to be sure we know
JUMPL 1,IOER1 ;what we're doing
CAIL 1,NTABS*20 ;BB should have index to I/O channel
JRST IOER1 ;doesn't, ignore interrupt
IDIVI 1,NTABS ;should be pointing to first of block
JUMPN 2,IOER1 ;ignore int if it isn't
HRRZ 1,IAC+1 ;AC1 at time of interrupt
CAME 1,JFNTAB(BB) ;contains JFN?
JRST IOER1 ;no, flush
IORM 7,FLAGWD(BB) ;all seems in order, set error bits
IOER1: MOVSI 7,IAC ;restore AC's
BLT 7,7
DEBRK ;and resume I/O
IOERQQ: MOVEM 7,IAC+7
MOVEI 7,IAC
BLT 7,IAC+6
HRROI A,[ASCIZ \
% I/O error not from PA1050 at user location \]
PSOUT
MOVEI A,101
HRRZ B,RETSAV
MOVEI C,10
NOUT
JFCL
HRROI A,CRLFM
PSOUT
JRST IOER1
;CTOINT CTOIN1 ABDBRK
CTOINT: MOVEM A,IAC+A ;stash AC A on a control-O int
MOVEM B,IAC+B ;also AC B
MOVEI A,101 ;primary file
MOVSI B,.S ;sign of TYSTAT
XORB B,TYSTAT ;complement it.
SKIPGE B ;on now?
CFOBF ;yes, clear TTY output buffer
HRROI A,[ASCIZ /↑O
/]
PSOUT ;type out the echo for the ↑O
MOVE A,RETSAV ;see where the break was from
TLNE A,(1B5) ;from user mode?
JRST ABDBRK ;yes, not in a JSYS.
MOVE B,-1(A) ;get the instruction
CAME B,CPSOUT ;primary I/O?
CAMN B,CPBOUT ; ..
JRST CTOIN1 ;yes.
CAME B,CBOUT ;no, directed I/O?
CAMN B,CSOUT ; ..
CAIA
JRST ABDBRK ;no, just debreak
MOVE B,IAC+A ;yes, get the JFN.
CAIE B,100 ;primary file?
CAIN B,101 ; ..
CAIA ;yes
JRST ABDBRK ;no, return to it
CTOIN1: TLO A,(1B5) ;force TTY JSYS to quit.
MOVEM A,RETSAV ;put back for DEBRK
ABDBRK: MOVE A,IAC+A ;get the AC's back
MOVE B,IAC+B ; ..
DEBRK ;and dismiss the PSI
;NXPINT NXPBAD
NXPINT: MOVEM A,IAC+A
MOVEM B,IAC+B ;preserve two AC's
MOVEI A,.S ;this fork
GTRPW ;get the trap status word
SKIPN INPAT ;from inside PAT?
TLNE A,1 ;or from monitor map (spurious)?
JRST ABDBRK ;yes, quit, process continues.
HRRZS A ;address referred to
TRNE A,776000 ;reference to page 0 or 1 is ok.
CAMG A,JBREL ;above user's legit area?
JRST ABDBRK ;no, filling in space, ok
TRNN A,.S ;above .JBREL; in high segment?
JRST NXPBAD ;no, bad.
HRRZ B,JBHRL ;space allowed in high segment
CAMG A,B ;out of bounds in high seg?
JRST ABDBRK ;no, scratch page in high seg.
;***Should check UWP bit***
NXPBAD: MOVEM A,IAC+C ;stash address for a moment
HRRZ B,A ;page referenced by accident
LSH B,-11 ;page number from address
HRLI B,.S ;in this fork
SETO A, ;to oblivion
PMAP ;get rid of the page
MOVE A,IAC+C ;get the address back
MOVE B,USRENB ;did user ask for these errors?
TRNE B,1B22!1B23 ;by Ill Mem Ref or NXM?
JRST MINT1 ;yes, go sneak into MEMINT code.
MOVEI B,NXPTRP ;PC to get this trap
EXCH B,RETSAV ;put it in de-break PC
HRL B,A ;save address attempted too
MOVEM B,MONUPC ;***Where should this really go?
JRST ABDBRK ;and debreak, stopping user.
;NXPTRP ATUSER NXPHLT
;Here on non-PSI level after stopping user.
NXPTRP: MOVEM 17,ACS+17 ;stash user's AC's
MOVEI 17,ACS
BLT 17,ACS+16 ; ..
MOVE P,PATSTK ;get the stack AC to PDL
MOVE PF,PFLAGS ;and the general flags
HRROI A,[ASCIZ/?
? Illegal memory reference to address /]
PSOUT
PUSHJ P,CLRPSI ;PSI system not wanted during HALTF
MOVEI A,101 ;to TTY output
HLRZ B,MONUPC ;address attempted
MOVEI C,10 ;octal radix
NOUT ;type out the address
JFCL
ATUSER: HRROI A,[ASCIZ / at user PC /]
PSOUT
MOVEI A,101 ;address the TTY again
HRRZ B,MONUPC ;get the PC at time of error
TLO B,(1B5) ;user mode bit
; *** lost old arith flags. FOO.***
MOVEM B,PDL ;in case user says CONTINUE.
HRRZS B ;clear for NOUT
MOVEI C,10 ;reset octal in case of ATUSER entry
NOUT ;type it out
JFCL ;"can't fail"
MOVEI A,EOL ;CRLF
PBOUT ;type CRLF
NXPHLT: PUSHJ P,CLRPSI ;clear compatibility vector and PSI system
SETZM INPAT ;no stack ahead
MOVSI 17,ACS ;restore user AC's
BLT 17,17 ; ..
HALTF ;how to stop and allow CONTINUE, make
; all this more general!!!
MOVE P,PATSTK ;user typed CONTINUE, can't, but need
MOVE PF,PFLAGS ;stack and flags to say so.
PUSHJ P,SETCV ;reset exec control
PUSHJ P,SETPSI ; ..
HRROI A,[ASCIZ/? Can't continue
/]
PSOUT
JRST NXPHLT
;NOCTRO OVINT FOVINT PDLINT MINT1
NOCTRO: MOVSI E,.S ;clear sign of TYSTAT
ANDCAB E,TYSTAT ;clear in AC and core
POPJ P, ;that's all
OVINT: SKIPE INPAT
JRST ERRINT
SETOM INPAT ;turn on PAT UUO simulator
MOVEM A,IAC+1
MOVE A,RETSAV
TLO A,(1B0) ;mark overflow in saved flags
UMOVEM A,.JBTPC ;setup return PC
MOVE A,CNIWRD
IFE KI10,<
TRO A,10 ;overflow
>;IFE KI10
JRST INT
FOVINT: SKIPE INPAT
JRST ERRINT
SETOM INPAT
MOVEM A,IAC+1
MOVE A,RETSAV
TLO A,(1B0+1B3) ;mark OV and FOV in flags
UMOVEM A,.JBTPC ;setup return PC
MOVE A,CNIWRD
IFE KI10,<
TRO A,100 ;floating overflow
>;IFE KI10
JRST INT
PDLINT: SKIPE INPAT
JRST ERRINT
SETOM INPAT
MOVEM A,IAC+1
MOVE A,RETSAV
UMOVEM A,.JBTPC ;setup return PC
MOVE A,CNIWRD
IFE KI10,<
TRO A,200000 ;PDL overflow
>;IFE KI10
JRST INT
MINT1: MOVE A,IAC+A ;here from NXPBAD, fake MEMINT
MOVE B,IAC+B ;by resetting AC's and then
JRST MINT2 ; jumping into mem int routine
;MEMINT MINT2 INT INSINT INSTRP INST1
MEMINT: SKIPE INPAT
JRST ERRINT
MINT2: SETOM INPAT
MOVEM A,IAC+1
MOVEM B,IAC+2
MOVEI A,400000
GTRPW
MOVE B,IAC+2
MOVE A,RETSAV
UMOVEM A,.JBTPC ;setup return PC
MOVE A,CNIWRD
IFE KI10,<
TRO A,20000 ;mem pro violation
>;IFE KI10
INT: UMOVEM A,.JBCNI ;setup APR CONI
UMOVE A,.JBAPR
HRRM A,RETSAV ;return to user interrupt routine
MOVE A,IAC+1
SETZM INPAT ;turn off PAT UUO simulator
DEBRK
HALTF
INSINT: ;here on illegal instruction trap
MOVEM A,IAC+A ;stash user AC
MOVEI A,INSTRP ;diddle the debreak
EXCH A,RETSAV ;to come back at non-PSI level
MOVEM A,MONUPC ;stash the int location
MOVE A,IAC+A ;restore the AC
DEBRK ;clear off the PSI channel
INSTRP: MOVEM 17,ACS+17 ;stash all AC's
MOVEI 17,ACS ; ..
BLT 17,ACS+16 ; ..
MOVE P,PATSTK ;get a PDL stack
MOVE PF,PFLAGS ;and system flags
SETOM INPAT ;flag PAT stack ready, etc.
HRROI A,[ASCIZ/?
? Illegal instruction /]
PSOUT
MOVEI A,PROJFN ;to the TTY
MOVE D,MONUPC ;where it came from
UMOVE B,-1(D) ;where instruction should be
MOVEM D,MONUPC ;restore MONUPC, clobbered by UMOVE
MOVEI C,↑D8 ;list it in octal
NOUT ;type it as a number
JFCL
TLC B,(<JRST 4,0>) ;is it a HALT?
TLNE B,777400 ; ..
JRST INST1 ;no.
HRROI A,[ASCIZ/ (Halt)/]
PSOUT
INST1: JRST ATUSER ;and the PC, then stop.
;REMAP REMAP3 REMAP1 REMAP2 REMAP4
SUBTTL More UUO simulations
REMAP: MOVE D,CAC ;user argument in words
TRO D,1777 ;round up to next 10/50 block boundary
CAIL D,400000 ;below max?
JRST MRETN ;no, return bad
AOS 0(P) ;set return good
HRRZM D,JBREL ;clear memory of high seg
SETZM JBHRL
XCTUU [HRRM D,.JBREL] ;set new .JBREL
XCTUU [SETZM .JBHRL] ;flush old hiseg size
ADDI D,1 ;first address of stuff to be moved
SETO 1, ;set about clearing old hiseg
MOVE 2,[XWD 400000,400] ;this fork,,page 400
REMAP3: PMAP ;map into oblivion
MOVEI 3,0(2)
CAIGE 3,PATPAG-1 ;until we reach this code
AOJA 2,REMAP3
LDB 1,[POINT 9,D,26] ;number of first page to move
HRLI 1,400000 ;XWD FORK,PN for RPACS
REMAP1: TRNE 1,400 ;reached top of low seg?
JRST REMAP2 ;yes
RPACS ;check this page
TLNE 2,(1B5) ;does it exist?
TLNN 2,(1B2+1B3+1B4) ;yes, is it accessible?
JRST .+2 ;no, outside low segment
AOJA 1,REMAP1 ;yes, keep checking
REMAP2: MOVEI 1,0(1) ;top of REMAP block found, get pn
MOVEM 1,LOTOP ;page beyond low segment
LSH 1,↑D9 ;make into address
CAIG 1,0(D) ;of non-0 size?
JRST MRETN ;no, nothing to do
MOVSI 2,0(D) ;XWD FROM,TO for BLT
HRRI 2,400000
SUBI 1,(D) ;size of hiseg
ADDI 1,377777 ;top location
CAIL 1,PATLOC ;don't step on self
JRST MRETN ;not possible to do REMAP.
HRRZM 1,JBHRL
XCTUU [HRRM 1,.JBHRL] ;note it
BLT 2,0(1)
SETO 1, ;now flush the block from the low seg
LDB 2,[POINT 9,D,26]
HRLI 2,400000
MOVE D,LOTOP ;page beyond low segment
REMAP4: PMAP
CAILE D,(2)
AOJA 2,REMAP4
JRST MRETN
;RUNTIM RUNTM0 RUNTM1 RUNTM2 RUNTM8 RUNTM3 RUNTM9
;The following routines all have conversions to and from seconds
RUNTIM: JUMPE CAC,RUNTM9 ;job zero means self
MOVE A,[SIXBIT /TICKPS/]
SYSGT ;get ticks per second
MOVE B,A
HRLZ A,CAC ;job number to LH of A
HRRI A,1 ;table 1, runtime indexed by job
GETAB
MOVEI A,0 ;error on look gives zero result
JUMPGE A,.+2 ;positive no is ok
MOVEI A,0 ;negative number says no such job
RUNTM0: MOVEI E,↑D1000 ;most common units
CAMN B,E ;already correct units?
JRST RUNTM8 ;yes
RUNTM1: CAMGE B,E ;is the value in smaller units than final ans?
JRST RUNTM3 ;no
IDIV B,E ;divide the larger fudge factor by the smaller
RUNTM2: IDIV A,B ;now divide by the ff
RUNTM8: JRST STOTAC ;return to user's AC
RUNTM3: IMUL A,E ;this result should fit
JRST RUNTM2
RUNTM9: MOVNI 1,5
RUNTM ;get run time for this job
JRST RUNTM0
;TIMER SLEEP PJOB GETPPN PJOB GETPPN MSTIME MSPDAY
TIMER: MOVEI E,↑D60 ;clock ticks (60ths) since midnight
SETO B, ;to request current time
SETZ D, ;normal flags
ODCNV
MOVEI A,0(D) ;seconds since midnight
MOVEI B,1 ;units (seconds)
JRST RUNTM1 ;go convert to proper units and return
SLEEP: MOVE A,CAC ;number of seconds to sleep
ANDI A,7777 ;mod 2↑12
IMULI A,↑D1000 ;convert to ms.
DISMS ;dismiss for appropriate time
JRST MRETN
IFE CONPPN,<
PJOB: SKIPA A,MYJOBN ;get number set at once time
GETPPN: MOVE A,MYPPN ;get 1,,directory number
JRST STOTAC
>;IFE CONPPN
IFN CONPPN,<
PJOB: MOVE A,MYJOBN
JRST STOTAC
GETPPN: GJINF ;IMSSS prefers currently connected dir
MOVE A,B
HRLI A,1 ;return 1,,condirn
JRST STOTAC
>;IFE CONPPN
MSTIME: TIME ;get uptime in ms
SUB 1,ITIME1 ;minus time at start
ADD 1,ITIME2 ;plus tod at start = tod in msec
IDIV 1,MSPDAY ;in case over a day
MOVE A,B ;answer to return
JRST STOTAC
MSPDAY: EXP ↑D<24*60*60*1000> ;milliseconds per day
;TMPCOR TMPCO1 TMPCO2 TMPCNX TMPCFE TMPTAB TCNUM
;TMPCOR UUO.
;Simulated by map operations on file ]TMPCOR[.TMP;T in connected directory.
;Only one page used for now, code changes needed for more.
;File JFN kept in TMPJFN. File page mapped at TMPCPG.
;See comments at TMPIDT for data structures.
TMPCOR:
IFN CCA,< ; Golly gee I hope this can be removed someday!
JRST MRETN ;TMPCOR is a no-op on CCA because CCA's version
;of MACRO apparently does not work with TMPCOR.
;FORTRAN works okay though, so it's either a
;bug in MACRO or in CCL.
>;IFN CCA
SKIPE TMPJFN ;already have the file open?
JRST TMPCO2 ;yes
HRROI B,[ASCIZ /]TMPCOR[.TMP;T/]
MOVSI A,(1B2+1B5+1B8) ;no see if file exists already
GTJFN
JRST TMPCNX ;it doesn't, make one
MOVEM A,TMPJFN ;ok, save JFN
TMPCO1: MOVE B,[↑D36B5+1B19+1B20] ;open, read and write access
OPENF
JRST TMPCFE ;error? Give up
HRLZ A,TMPJFN ;map the page
MOVE B,[400000,,TMPCPG]
MOVSI C,(1B2+1B3)
PMAP
MOVE B,[TMPIDT,,TMPPAG] ;BLT pointer to init with
MOVE A,TMPHDR ;get header word
CAME A,TMPIDT ;good stuff?
BLT B,TMPBEG-1 ;no, initialize TMPCOR page
;Here to dispatch on the requested opcode
TMPCO2: HLRZ A,CAC ;get code from LH of AC
CAIGE A,TCNUM ;dispatch if legal
JUMPGE A,TMPTAB(A)
JRST MRETN ;just error return if not
;Here if TMPCOR file nonexistent on first call
TMPCNX: MOVSI A,(1B0+1B5+1B8) ;output, temp, ignore deleted
HRROI B,[ASCIZ /]TMPCOR[.TMP;T/]
GTJFN
JRST MRETN ;?? give up (pretend not implemented)
MOVEM A,TMPJFN ;save JFN
MOVE B,[↑D36B5+1B19+1B20] ;open, read and write access
OPENF
JRST TMPCFE ;error?? Give up
HRLI A,400000 ;now close to make file really exist
CLOSF ;but don't release JFN
PUSHJ P,ERROR
MOVE A,TMPJFN
JRST TMPCO1 ;now go map the page
;Here on funny OPENF errors -- release the JFN and non-skip return
TMPCFE: MOVE A,TMPJFN
RLJFN
PUSHJ P,ERROR
SETZM TMPJFN ;indicate no JFN now
JRST MRETN ;error return
;The TMPCOR dispatch table
TMPTAB: JRST .TCRFS ;(0) Read free space
JRST .TCRRF ;(1) Read file
JRST .TCRDF ;(2) Read and delete file
JRST .TCRWF ;(3) Write file
JRST .TCRRD ;(4) Read directory
JRST .TCRDD ;(5) Read and delete directory
TCNUM==.-TMPTAB ;no. functions known about
;.TCRFS TMPERF .TCRRF .TCRDF .TCRF1 .TCRF2
;TMPCOR -- individual functions
;Return free space total in AC
.TCRFS: AOS 0(P) ;preset skip return
TMPERF: HRRZ A,TMPFRE ;get # free words
SOJGE A,STOTAC ;tell user about all but one
AOJA A,STOTAC ;since any write will require a header
;Read file given parameter block pointed to by AC.
;Error return with free space total if not found.
;Skip return with size of file in AC if found.
.TCRRF: PUSHJ P,TMPFND ;find the file
JRST TMPERF ;not found, error return
JRST .TCRF1 ;join common code below
;Read file as in .TCRRF and also delete it.
.TCRDF: PUSHJ P,TMPFND ;find the file
JRST TMPERF ;not found, error return
MOVSI C,(1B0) ;mark the block free
IORM C,TMPPAG(A)
ADDM B,TMPFRE ;account in free space total
.TCRF1: MOVSI A,TMPPAG+1(A) ;make BLT from ptr to first word of data
UMOVE C,1(CAC) ;get user's IOWD
HRRI A,1(C) ;make BLT to pointer
HLRE C,C ;get size of IOWD
MOVN C,C ;make positive
JUMPLE C,.TCRF2 ;we already transferred no words
CAILE C,-1(B) ;IOWD size smaller than file size?
MOVEI C,-1(B) ;no, bigger, cut it down
ADDI C,(A) ;point to first word after end of BLT
XCTMU [BLT A,-1(C)] ;copy the data to the user buffer
.TCRF2: MOVE A,B ;give file size to user
SOJA A,STOTC1 ;and skip return
;.TCRWF .TCRW1 .TCRW2 .TCRW3 .TCRW4
;TMPCOR (continued)
;Write file given parameter block pointed to by AC.
;First delete file if already exists (that's what the spec says!)
;then error if not enough room for file with free space total in AC.
;Else write file and skip return with updated free space in AC.
.TCRWF: PUSHJ P,TMPFND ;look for existing file with same name
JRST .TCRW1 ;not found
MOVSI C,(1B0) ;found one, mark the block free
IORM C,TMPPAG(A)
ADDM B,TMPFRE ;account in free space total
.TCRW1: UMOVE C,1(CAC) ;get the user's IOWD
JUMPGE C,TMPERF ;take error return if not valid IOWD
HLRE B,C ;get size of IOWD
MOVN B,B ;make positive
CAML B,TMPFRE ;enough room (including header)?
JRST TMPERF ;no, error return with free space in AC
AOS A,B ;ok, include header in size
ADD A,TMPNXT ;see what happens when we chew some space
CAILE A,1000 ; off the end of the used zone
JRST .TCRW2 ;not enough room, need to garbage collect
MOVN D,B ;ok, account for space being taken
ADDM D,TMPFRE
EXCH A,TMPNXT ;advance free pointer
XCTUU [HLL B,0(CAC)] ;get filename from user
MOVSM B,TMPPAG(A) ;store SIZE,,NAME in header word
HRLI A,1(C) ;first from address in user space
ADDI A,TMPPAG+1 ;first real address in block
ADDI B,-1(A) ;first address after block
XCTUM [BLT A,-1(B)] ;move the data to the file
JRST .TCRFS ;skip return giving free space
;Here when need to garbage collect.
.TCRW2: MOVEI A,TMPBEG-TMPPAG ;init target ptr
MOVEI B,TMPBEG-TMPPAG ;init source ptr
.TCRW3: HLRE C,TMPPAG(B) ;get a block size
TRZ C,400000 ;clear deleted bit
JUMPL C,.TCRW4 ;ignore block if deleted
;update only source so block will be flushed
MOVSI D,TMPPAG(B) ;block in use, make BLT pointer
HRRI D,TMPPAG(A)
ADDI A,(C) ;update target pointer
BLT D,TMPPAG-1(A) ;move the block from source to target
.TCRW4: ADDI B,(C) ;update source pointer
CAMGE B,TMPNXT ;past end of in-use data?
JRST .TCRW3 ;no, continue gc
MOVEM A,TMPNXT ;yes, store new free pointer
MOVEI B,1000 ;recompute free space count
SUBI B,(A)
MOVEM B,TMPFRE
JRST .TCRW1 ;retry write (know it will succeed)
;.TCRRD .TCRDD .TCRR1 .TCRR2 .TCRR3 TMPFND TMPFN1 TMPFN2 TMPIDT TMPPAG TMPHDR TMPFRE TMPNXT TMPBEG
;TMPCOR (continued)
;Read directory into user buffer and return number of files in AC.
.TCRRD: HRRZ D,TMPNXT ;stop scan at first free block
JRST .TCRR1
;Read directory as for .TCRRD and also delete it.
.TCRDD: HRRZ D,TMPNXT ;stop scan at first free
MOVE B,[TMPIDT,,TMPPAG] ;initialize the directory
BLT B,TMPBEG-1
.TCRR1: UMOVE B,1(CAC) ;get user's IOWD
SETZ A, ;init count of files in dir
MOVEI C,TMPBEG-TMPPAG ;init pointer to first block
.TCRR2: CAML C,D ;past end of used blocks?
JRST STOTC1 ;yes, skip return with count in AC
MOVS E,TMPPAG(C) ;no, get block header
SUBI E,1 ;don't include header in size
TRZE E,400000 ;deleted?
SOJA A,.TCRR3 ;yes, skip over it
SKIPGE B ;still room in user buffer?
UMOVEM E,1(B) ;yes, store directory entry
AOBJN B,.+1 ;advance IOWD
.TCRR3: ADDI C,1(E) ;advance to next block
AOJA A,.TCRR2 ;count files and loop
;Subroutine to lookup a TMPCOR file.
;Nonskip return if not found.
;Skip return if found with address (relative to TMPPAG) in A
; and size (including header) in B.
TMPFND: MOVEI A,TMPBEG-TMPPAG ;init lookup pointer
XCTUU [HLRZ C,0(CAC)] ;get filename from user parameter block
TMPFN1: CAML A,TMPNXT ;reached free zone?
POPJ P, ;yes, file not found
MOVS B,TMPPAG(A) ;get NAME,,SIZE header word
TRZE B,400000 ;deleted block?
JRST TMPFN2 ;yes, skip over
TLC B,(C) ;no, check name
TLNN B,-1
JRST CPOPJ1 ;match, skip return
TMPFN2: ADDI A,(B) ;advance to next block
JRST TMPFN1
;Data structure for TMPCOR simulation.
TMPIDT: ;this block used for initializing TMPPAG
PHASE TMPCPG*1000
TMPPAG:
TMPHDR: SIXBIT /TMPCOR/ ;for consistency check
TMPFRE: 1000-<TMPBEG-TMPPAG> ;# free words, including deleted blocks
TMPNXT: TMPBEG-TMPPAG ;beginning of free region
TMPBEG: ;data storage starts here
DEPHASE
;The block format is a header word containing WORD COUNT,,NAME
;followed by N-1 words of data (i.e. the word count includes
;the header). Bit 0 is set if the block is deleted. Allocation
;consists of taking the next N words from the free zone starting
;at the location pointed to by TMPNXT. When this is exhausted,
;garbage collection is invoked to compress out all deleted blocks.
;Liberation consists simply of setting the deleted bit and updating
;TMPFRE.
;GETCHR DEVCHR DEVCH1 GETDEV DEVSIZ DEVTYP DVTYP1
;Some device type things
GETCHR:
DEVCHR: MOVE D,CAC ;sixbit device name
JUMPL D,DEVCH1 ;if it is neg. must be sixbit
CAIGE D,20 ;is it a channel
PUSHJ P,GETDEV ;yes go get associated device
DEVCH1: PUSHJ P,DVCHR1 ;call common routine
JFCL ;nonexistent device
JRST STOTAC ;return AC A to user
GETDEV: SETZM A ;set return in case no device
IMULI D,NTABS ;get table offset
SKIPN D,DEVNAM(D) ;get device
AOS 0(P) ;if no device skip return
POPJ P, ;return
DEVSIZ: UMOVE D,1(CAC) ;get the sixbit arg device name
PUSHJ P,DVCHR1 ;get its characteristics
JRST RETM11 ;no such dev. Return a minus 1
HLRZ B,B ;get the Tenex device type
ANDI B,777 ; ..
UMOVE D,0(CAC) ;and the mode word
ANDI D,17 ;just the mode field
MOVNI A,2 ;answer if illegal
MOVEI E,1 ;bit for mode
LSH E,(D) ;to bit position
TDNN E,DEVTBL(B) ;legal?
JRST STOTC1 ;no. Return the -2
CAIL D,15 ;ok, is mode dump?
JRST RETZR1 ;yes, skip return a zero
HRRZ A,DEVTB2(B) ;no, buffered. Get buffer size
ADD A,[2,,3] ;LH is two buffers, RH is size with hdr
JRST STOTC1 ;return that as answer, skip.
DEVTYP: MOVE D,CAC ;get argument in case sixbit
TLNE CAC,-1 ;device name?
JRST DVTYP1 ;yes.
CAILE CAC,17 ;legal channel number?
JRST MRETN ;no
MOVEI A,(CAC) ;yes
IMULI A,NTABS ;get table offset
SKIPE D,DEVNAM(A) ;a device there?
DVTYP1: PUSHJ P,DVCHR1 ;yes, get the bits from Tenex DVCHR to B
JRST RETZR1 ;error, skip return with a zero
HLRZ D,B ;get the Tenex index
ANDI D,777 ; ..
MOVE A,DVTYPT(D) ;get fixed bits
HLRZ C,C ;get job number
CAIN C,-1 ;free?
MOVEI C,0 ;yes
DPB C,[POINT 9,A,26] ;put in answer
TLNE B,(1B5) ;available?
TLO A,(1B12) ;yes
JRST STOTC1 ;skip return with answer
;DVCHR1 DVCHR2 DEVC3 DEVC1 DEVC2 DEVPPN DEVPN1
;Common routine for DEVCHR, DEVSIZ
DVCHR1: PUSH P,D
GJINF
HRLI D,600012
EXCH D,0(P)
MOVEI B,NSPDDV-1 ;number of disk devices
CAMN D,SPDDVT(B) ;check for special device
JRST DVCHR2 ;handle special if so
SOJGE B,.-2 ;loop looking
CAIA ;not special device
DVCHR2: MOVSI D,'DSK'
CAMN D,[SIXBIT /TTY/]
JRST [ MOVSI D,(1B6) ;controlling terminal bits
HRLZI B,600012 ;save device type
JRST DEVC3] ; ..
HRROI E,BUFFER ;place to put ASCIZ string of device
PUSHJ P,SIXTO7
MOVEI C,0
MOVNI B,1 ;minus one flag if not found by DVCHR
HRROI A,BUFFER ;argument for string to device
STDEV ;get the device type
JRST DEVC2 ;none
MOVE A,B ;to right AC
DVCHR ;get the bits
HLRZ D,B
ANDI D,777 ;device number
MOVE D,DEVTBL(D) ;10/50 device characteristics
TLNE B,(1B5) ;is the thing available to this job?
TLO D,40 ;yes
TLNE B,(1B6) ;assigned?
TRO D,1B18 ;yes, set ASSCON in 10/50 mode word
CAMN A,0(P) ;was it the job's TTY?
DEVC3: TDO D,CONTTY ;yes, put in extra bits
DEVC1: AOS -1(P) ;skip return
DEVC2: MOVE A,D ;characteristics in A for
POP P,(P) ;discard stacked TTY designator
POPJ P, ;caller to return to user
; DEVPPN partial implementation
DEVPPN: MOVE A,MYPPN ;most things are "me"
MOVEI B,NSPDDV-1 ;number of disk devices
CAMN CAC,SPDDVT(B) ;check for special device
JRST DEVPN1 ;handle special if so
SOJGE B,.-2 ;loop looking
JRST STOTC1 ;return "me" std device--handle
DEVPN1: SETZ A, ;get PPN for SYS
HRRO B,SPDDVN(B) ;get name of device
STDIR
JFCL
PUSHJ P,ERROR ;must be a SUBSYS directory
HRLI A,1 ;return 1,,N
JRST STOTC1 ;to user's AC, skip ret
;CONTTY DEVTBL DEVTTY DEVTB2
;10/50 device characteristics
CONTTY: XWD 030053,400003 ;bits for a controlling TTY
DEVTBL: XWD 201047,154403 ;DSK A,AL,I,B,IB,DR,D
XWD 0,0 ;DRM
XWD 000023,154403 ;MTA DITTO DSK
XWD 001107,154403 ;DTA DITTO DSK
XWD 000202,014403 ;PTR A,AL,I,B,IB
XWD 000401,014403 ;PTP DITTO PTR
XWD 002001,020000 ;DSP ID ONLY
XWD 040001,000403 ;LPT A,AL,I
XWD 100002,010403 ;CDR A,AL,I,B
XWD 100001,014003 ;CDP A,AL,B,IB
DEVTTY: XWD 000053,000403 ;TTY A,AL,I
XWD 000053,000003 ;TTP
XWD 000053,000003 ;TTR
XWD 000043,014403 ;NIL
XWD 000047,014403 ;NET
XWD 000001,014400 ;PLT
;10/50 standard buffer size for each device
DEVTB2: EXP 200,0,200,177,40,40,0,31,33,32,20,20,20,200,100,43,20
;DVTYPT
;Table of bits for DEVTYP CALLI
DVTYPT: 400003,,0 ;DSK
0 ;DRM
7,,2 ;MTA
400003,,1 ;DTA
6,,4 ;PTR
5,,5 ;PTP
0 ;DSP
5,,7 ;LPT
2,,10 ;CDR
1,,11 ;CDP
13,,3 ;TTY
13,,3 ;TTP
13,,3 ;TTR
3,,0 ;NIL
0 ;NET
1,,13 ;PLT
;UTPCLR DATE NODATE
UTPCLR: PUSHJ P,SETUPG
JRST MRETN
CAIE AA,3 ;is it DECtape?
JRST MRETN ;no, UTPCLR is a nop
INIDR ;yes, initialize the directory
PUSHJ P,ERROR
JRST MRETN
DATE: SETO B, ;to request currend tad
PUSHJ P,NODATE
MOVE A,D ;date to A for return to user
JRST STOTAC ; ..
;Given gtad format d&t in B, return DEC format date in D, time in B
NODATE: SETZ D, ;normal flags
ODCNV ;get year, month, day, etc.
HRRZ A,D ;save seconds since midnight
HLRZ D,B ;year
SUBI D,↑D1964 ;convert to 10/50 format, i.e. ...
IMULI D,↑D12 ;(YEAR-1964)*12
ADDI D,0(B)
IMULI D,↑D31 ;((YEAR-1964)*12+(MONTH-1))*31
HLRZ C,C
ADDI D,0(C) ; ... +DAY-1
MOVEI B,(A) ;secs since midnight
IDIVI B,↑D60 ;minutes
POPJ P,
;GSTATS GST2 UGETST USTATO USTATZ
SUBTTL UUOs for file operations
;File stuff
GSTATS: PUSHJ P,SETUP
MOVE C,FLAGWD(BB)
MOVE B,DEVTBL(AA) ;device type bits
TLNE B,MTADEV ;magtape?
JRST GST2 ;yes
HRRZ A,C
POPJ P,
;Routine to get status for magtape.
;Returns with GDSTS data in B, updated 10/50 status in A.
;IOBKTL isn't set, due to the complexity of 1B23 of Tenex GDSTS.
;The caller is left to do that.
GST2: MOVE A,JFNTAB(BB) ;argument to GDSTS
GDSTS ;get Tenex status
MOVE C,FLAGWD(BB) ;old ten fifty status
TRZ C,606000 ;bits which may need updating
MOVE A,B ;Tenex bits to A
ANDI A,606000 ;only ones to keep are matching hdw bits
IOR A,C ;add in old status and IOBKTL
HRRZS A ;just right-half
POPJ P, ;return
UGETST: PUSHJ P,GSTATS
UMOVEM A,@FORTY
JRST MRETN
USTATO: PUSHJ P,GSTATS
TDNE A,FORTY
JRST MRETN2 ;skip return
JRST MRETN ;noskip return
USTATZ: PUSHJ P,GSTATS
TDNN A,FORTY
JRST MRETN2 ;skip return
JRST MRETN ;noskip return
;USETST UOPEN UINIT UINIT1 UOPEN1 UOPEN2
USETST: PUSHJ P,SETUP
MOVE A,JFNTAB(BB)
HRRZ B,FORTY
HRRM B,FLAGWD(BB) ;save mode etc
MOVSI A,TTYDEV
TDNE A,DEVTBL(AA) ;TTY?
PUSHJ P,TTYSTS ;yes
JRST MRETN
UOPEN: TLOA C,-1
UINIT: TLZ C,-1
PUSHJ P,SETUPG ;is a device already INIT'ed?
JRST UINIT1 ;no
PUSH P,C ;save whether OPEN or INIT
PUSHJ P,URELR ;call RELEASE for this channel
POP P,C
UINIT1: JUMPL C,UOPEN1 ;was it open?
MOVE A,(P) ;A to point at first of three args
AOS 0(P)
AOS 0(P) ;P to point to R1
MOVE C,FORTY ;may be the result of an XCT
SOJA A,UOPEN2
UOPEN1: HRRZ A,FORTY ;effective adr is pointer to three args
UMOVE C,(A)
UOPEN2: HRRZM C,FLAGWD(BB) ;takes care of status for now
UMOVE C,2(A)
MOVEM C,BUFHTB(BB) ;XWD OBUFH,IBUFH
UMOVE C,1(A) ;sixbit name from user
MOVEM C,DEVNAM(BB) ;save it in sixbit
PUSHJ P,DEV67 ;put it in DEVNM7
MOVE C,DEVNAM(BB) ;get sixbit back
; JRST UOPEN3
;UOPEN3 UOPENE
;Find out what device really is
;Check for legal mode
;Set buffer size and byte size in C
UOPEN3: HRROI A,DEVNM7
MOVEI B,0
MOVEI D,NSPDDV-1 ;number of special disk devices
CAMN C,SPDDVT(D) ;check for special disk device
JRST UOPENE ;handle if so
SOJGE D,.-2 ;loop looking if not
MOVSI B,12
CAMN C,[SIXBIT /TTY/]
JRST UOPENE
STDEV ;get device designator
JRST MRETN ;no such device, check for 10/50 names!!
UOPENE: MOVEM B,DEVNUM(BB) ;save device designator
MOVE D,FLAGWD(BB)
CAMN C,[SIXBIT /TTY/] ;controlling terminal?
HRRZM D,TYSTAT ;yes, update the copy we're keeping
LDB AA,PDVNUM ;get the Tenex device type number
MOVE C,DEVTBL(AA) ;get legal 10/50 mode bits
ANDI D,17 ;what mode
MOVEI E,1
ROT E,(D) ;put bit in 35-N
TRNN C,(E) ;is mode legal for this device
JRST MRETN ;no ****Not right. Should be ILLMOD***
CAILE D,14 ;buffered?
JRST UOPEN4 ;no
MOVSI C,004400 ;fiddle with mode number to get byte size
CAIGE D,10 ;mode >=10?
MOVSI C,000700 ;no, 7 bit, not 36
MOVEI E,0
MOVE D,BUFHTB(BB)
TRNN D,-1 ;is there an input header?
JRST .+4 ;no
UMOVEM E,(D)
UMOVEM C,1(D)
UMOVEM E,2(D)
HLRZ D,D ;first time left half is output header
JUMPN D,.-4 ;either no out hdr or second time thru
; JRST UOPEN4
;UOPEN4 NOTMTA UOPEN6 UOPEN7 UOPEN5 PDVNUM
UOPEN4: MOVSI B,INITF ;channel INIT'ed
IORB B,FLAGWD(BB) ;mark it.
MOVEI D,17
ANDI D,(B)
MOVE B,DEVTBL(AA)
TLNE B,DTADEV ;DECtape in buffered mode?
CAILE D,14
TLNE B,DSKDEV ;or DSK?
JRST MRETN2 ;yes, can't GTJFN yet.
MOVE B,DEVTBL(AA)
TLNN B,DTADEV!MTADEV ;is it a DECtape or magtape?
JRST UOPEN6 ;no, all done
IFN MTWEOF,<
TLNN B,MTADEV ;is it MTAn?
JRST NOTMTA ;no
PUSH P,B ;save B temporarily
SETZ A, ;assume MTA0:
MOVE B,DEVNAM(BB) ;get sixbit name of device
CAME B,[SIXBIT /MTA0/]
MOVEI A,1 ;must be MTA1:
SETZM MTAWR(A) ;mark not written yet
POP P,B ;restore B
NOTMTA:
>;IFN MTWEOF
MOVE A,DEVNUM(BB) ;get device designator
TLO A,(1B3) ;supress reading directory
MOUNT
PUSHJ P,ERROR
UOPEN6: MOVS A,DEVNAM(BB) ;get device name
CAIE A,'TTY' ;user console?
JRST UOPEN7 ;no
MOVEI A,PROJFN ;yes, use primary
MOVEM A,JFNTAB(BB)
PUSHJ P,TTYSTS ;set status
JRST MRETN2 ;done
UOPEN7: MOVSI A,TTYDEV
TDNE A,DEVTBL(AA) ;is device a TTY?
PUSHJ P,TTYSTS ;yes, set status
PUSHJ P,UOPEN5 ;setup JFN table
GTJFN
PUSHJ P,ERROR
MOVEM A,JFNTAB(BB)
JRST MRETN2
UOPEN5: MOVE A,[XWD JBLOCK+3,JBLOCK+4]
SETZM JBLOCK+3
BLT A,JBLOCK+10
HRROI A,DEVNM7 ;name of device in ASCIZ
MOVEM A,JBLOCK+2
MOVE A,[XWD 377777,377777]
MOVEM A,JBLOCK+1
SETZM JBLOCK
SETZ B,
MOVEI A,JBLOCK
POPJ P,
PDVNUM: POINT 6,DEVNUM(BB),17 ;numeric device type from designator
;UINBUF UOUTBF IOBUF UIOBFL
UINBUF: TLOA C,-1
UOUTBF: TLZ C,-1
PUSHJ P,SETUP
MOVE D,FLAGWD(BB)
TLNN D,INITF ;channel INIT'ed?
PUSHJ P,ERRCHN ;no-you lose
MOVE CC,BUFHTB(BB)
TLNN C,-1 ;header pointer already in right half?
HLRZ CC,CC ;OBUF,IBUF←0,OBUF
MOVSI B,INBUFF
TLNN C,-1
MOVSI B,OUTBFF
HRRZ C,FORTY ;number of buffers in ring
CAIN C,0 ;did user specify zero buffers?
MOVEI C,2 ;yes, give him two
PUSHJ P,IOBUF
JRST MRETN
IOBUF: IORM B,FLAGWD(BB)
UMOVE D,.JBFF ;where to start ring
MOVEI E,(D) ;spare copy of start
MOVE B,DEVTB2(AA)
MOVEI G,3(B) ;total length of each buffer
IMULI G,(C) ;times number of buffers
ADDI G,(D) ;plus beginning address
CAILE G,PATLOC ;must be below compatibility code
PUSHJ P,ERRARG
CAML G,JBREL ;is there enough core now?
PUSHJ P,XPAND ;no, get some more
MOVSI F,400000 ;ring use bit
HRRI F,1(D) ;pointer to second word of first buffer
UMOVEM F,(CC) ;goes in first word of header
MOVSI F,1(B) ;SIZE+1 in LH of second word of each buffer
UIOBFL: HRRI F,1(D) ;pointer to self in right half
ADDI F,3(B) ;plus length of a complete buffer
CAIN C,1 ;except the last buffer
HRRI F,1(E) ;which points back to the first
UMOVEM F,1(D) ;set ring ptr to XWD SIZE+1,NXTBUF+1
ADDI D,3(B) ;point beyond this buffer
SOJG C,UIOBFL ;back if more buffers to set up
XCTUU [HRRM D,.JBFF] ;set .JBFF beyond buffers
POPJ P,
;XPAND
XPAND: PUSH P,CAC ;CORE UUO wants arg in CAC
HRRZ CAC,G ;phony up a CORE UUO for low seg.
PUSH P,B
PUSH P,C
PUSH P,D
PUSHJ P,CORU10 ;expand core to get it
PUSHJ P,ERROR ;error return- couldn't
POP P,D
POP P,C
POP P,B
POP P,CAC ;restore I/O call CAC
POPJ P, ;ok- all done.
;ULOOKP ULK6 ULK7 ULK1
ULOOKP: PUSHJ P,SETUP
MOVE D,FLAGWD(BB)
TLNN D,INITF
PUSHJ P,ERRCHN
PUSHJ P,DIRCHK ;skip if has directory
JRST MRETN2 ;no, nop.
MOVEI A,1 ;close input side
MOVEM A,IOCNT
PUSHJ P,UCL1R ;close it and release JFN
ANDI D,17
MOVE B,DEVTBL(AA)
TLNE B,DTADEV ;DECtape in buffered mode?
CAILE D,14
TLNE B,DSKDEV ;or DSK?
JRST ULK6 ;yes- do GTJFN now
SKIPN A,JFNTAB(BB) ;no- must have JFN already
PUSHJ P,ERRCHN
JRST ULK7
ULK6: PUSHJ P,LUKPAR
MOVSI A,102000
MOVEM A,JBLOCK ;version 0, bits for reading
HRROI B,XFILEN
MOVEI A,JBLOCK
GTJFN
IFE LINKP,<
JRST LOOKER
>;IFE LINKP
IFN LINKP,<
PUSHJ P,LOOKER ; if LOOKER can find it via link, returns here
>;IFN LINKP
MOVEM A,JFNTAB(BB) ;assigned JFN
ULK7: MOVEI B,1B19 ;open for input
PUSHJ P,OPENX
MOVSI B,IOPENF!LOOKPF
IORM B,FLAGWD(BB) ;denote file open so CLOSE will really close
LDB B,PDVNUM ;get device type number
MOVSI D,200000 ;multiple directory device bit
TDNN D,DEVTBL(B) ;is it one of those?
JRST MRETN2 ;no, all done for now
ULK1: MOVSI B,22 ;XWD 22,0 i.e. whole FDB
MOVEI C,FDBB ;PSB buffer for file descriptor block
GTFDB
MOVE B,FDBB+15 ;last ref date and time
PUSHJ P,NODATE
MOVE E,D ;save reference date
MOVE B,FDBB+14 ;get last write d&t
PUSHJ P,NODATE ;convert that to 10/50 form too
LDB A,[POINT 3,D,23] ;get top 3 bits of write date
DPB A,[POINT 3,E,20] ;store it over with the access date
PUSHJ P,PARXCT ;store that pair in LOOKUP block
HRRM E,1(G) ;here if short form,
HRRM E,3(G) ;here if long form
;falls through
;ULK3 ULK10 ULK11
ANDI D,7777 ;low 12 bits of write date
LSH B,↑D12 ;move time over above that
IOR D,B ;time and date of write
HRRZ A,FDBB+4 ;file protection
PUSHJ P,T50PRT ;convert to 10/50 protection
IOR D,C ;put that in with write d&t
PUSHJ P,PARXCT ;and store all that in LOOKUP block
MOVEM D,2(G) ;short form
MOVEM D,4(G) ;or long form
ULK3: LDB B,[POINT 6,FDBB+11,11] ;byte size
SKIPN B ;make 0 byte size 36
MOVEI B,↑D36 ;to prevent divide by zero
MOVEI A,↑D36
IDIVI A,(B) ;no of bytes in a word
MOVE B,FDBB+12 ;no of bytes in file
IDIVI B,(A) ;no of words in file
SKIPE C ;integer words
ADDI B,1 ;round up
TRNE PF,R.UEXT ;extended LOOKUP?
JRST ULK10 ;yes, go return -words
MOVEI C,177(B) ;no, compute it in blocks.
ASH C,-7 ; ..
CAIG B,377777 ;.LT. 128K words?
MOVNI C,(B) ;yes, return neg num of words
XCTUU [HRLM C,3(G)] ;return -WDS or +BLKS to LOOKUP block
JRST ULK11
ULK10: UMOVEM B,5(G) ;store file size in ext LOOKUP block
UMOVE B,0(G) ;get number of args
MOVEI B,0(B) ; ..
CAIGE B,6 ;room for version?
JRST ULK11 ;no
HLRZ B,FDBB+7 ;yes, get version.
UMOVEM B,6(G) ;return value.
ULK11: JRST MRETN2
;OPENX OPENX7 OPENX5
OPENX: MOVE D,FLAGWD(BB)
TLNE D,INITF ;is it INIT'ed?
SKIPN A,JFNTAB(BB) ;and has it a JFN?
PUSHJ P,ERRCHN ;no
MOVE C,B ;save mode for opening
GTSTS
JUMPGE B,OPENX3 ;is file already open?
TLNE B,(1B1) ;yes, open for input?
TRO C,1B19 ;yes, save that info
TLNE B,(1B2) ;open for output?
TRO C,1B20 ;yes, save that info
SKIPG MAPTAB(BB) ;yes, have a page mapped?
JRST OPENX7 ;no.
PUSH P,C ;save open bits
MOVEI B,(BB) ;reconstruct page number.
IDIVI B,NTABS ;from table offset
MOVEI B,IOMPGS(B) ;page number.
HRLI B,.S ;in this fork
SETO A, ;to oblivion
SETZM MAPTAB(BB) ;no more mapping
PMAP ;clear it out
POP P,C ;restore open bits
HRRZ A,JFNTAB(BB) ;get JFN back
OPENX7: TLO A,400000 ;preserve JFN
CLOSF ;and close file
PUSHJ P,ERROR
PUSH P,C ;save open bits
JUMPN AA,OPENX5 ;if not DSK, can't be deleted
MOVE B,[XWD 1,1] ;get word indicating deletion
MOVEI C,FDBTMP
HRRZ A,A
GTFDB
MOVSI C,(1B3)
TDNN C,FDBTMP ;is file deleted?
JRST OPENX5 ;no
HRLI A,1 ;yes, undelete it
MOVSI B,(1B3)
SETZ C,
CHFDB
HRLI A,12
SETO B,
CHFDB ;clear the eof counter
OPENX5: POP P,C
HRRZ A,A
; JRST OPENX3
;OPENX3 OPENX1 OPENX2 OPENX4 OPENX6
OPENX3: MOVE B,C ;now it can be opened
MOVEI C,17
ANDI C,(D) ;mode
LDB AA,PDVNUM ;get device type number
MOVE D,DEVTBL(AA)
TLNE D,DTADEV ;is this dump mode to DECtape?
CAIG C,14
TLNE D,MTADEV ;or anything to magtape?
JRST OPENX1 ;yes, open in dump mode
HRLI B,070000 ;no, open in ASCII mode
SKIPN BUFHTB(BB) ;any buffers? If not, try to suppress
TRO B,1B27 ;change of access date. -- CCL problem
TLNE D,PTRDEV+PTPDEV ;is paper tape?
JRST [ CAIGE C,10 ;yes, ASCII mode?
JRST OPENX2 ;yes
HRLI B,100000 ;byte size is 8 if image mode
CAIL C,13
HRLI B,440000 ;36 if binary mode
DPB C,[POINT 4,B,9] ;pass along mode
JRST OPENX2]
TLNN D,HASDIR ;unless this is a directory device
CAIL C,10 ;or binary mode specified
HRLI B,440000 ;in which case use binary mode
JRST OPENX2
OPENX1: HRLI B,447400 ;dump mode
OPENX2: HRRZ A,A
OPENF
JRST OPENX4
MOVE B,DEVTBL(AA)
TLNN B,MTADEV ;magtape?
POPJ P, ;no, all done
HRRZ B,FLAGWD(BB)
ANDI B,7B28 ;density and parity bits
TRO B,1B21 ;supress auto error correction
MOVE A,JFNTAB(BB)
SDSTS
POPJ P,
OPENX4: CAIN A,OPNX9 ;file busy?
TROE B,1B25 ;yes, try once more with thawed bit
CAIA ; not that err, or tried both
JRST OPENX6
CAIN A,OPNX11 ;priv's req'd to not change ref date?
TRZN B,1B27 ;yes, if trying to do that, forget it
CAIA
JRST OPENX6 ;and try again
CAIE A,OPNX8 ;unmounted device?
PUSHJ P,ERROR ;no, lose.
MOVE A,DEVTBL(AA)
TLNN A,PTRDEV ;papertape reader?
PUSHJ P,ERROR
MOVEI A,↑D5000
DISMS ;give the operator another 5 sec.
OPENX6: MOVE A,JFNTAB(BB)
JRST OPENX2 ;and try again
;LOOKER LOOKRX LOOKR2 OPENFR ER0 ER4 ER5
;0 - File not found
;1 - Directory not found
;2 - Read protected
LOOKER:
IFN LINKP,<
PUSH P,0 ; save some registers
PUSH P,1
PUSH P,2
PUSH P,3
PUSH P,4
PUSH P,5
SKIPN LINKS ; have we looked for links file before?
PUSHJ P,GETLNK ; no, then try now (only done once)
PUSHJ P,GNLNK ; get next link -- returns if we still
; can't find the file in any of the linked
; to directories
; If GNLNK finds a JFN it throws away this return and POPs the other saved
; registers off the stack (except for 1 and 2). It the POPJs back to the
; place that called LOOKER. If it fails it does a POPJ to here.
POP P,5
POP P,4
POP P,3
POP P,2
POP P,1
POP P,0
POP P,B ; get rid of the return, since we can't find
; a file for the klutz
; This just makes it look as though we had jumped here which is what happened
; originally.
>;IFN LINKP
MOVEI B,0
CAIN A,GJFX17 ;no such directory
AOJA B,LOOKR2
CAIE A,GJFX18 ;no such file name
CAIN A,GJFX19 ;no such ext
JRST LOOKR2
CAIN A,GJFX20 ;no such version
JRST LOOKR2
LOOKRX: SETZ B,
LOOKR2: XCTUU [HRRM B,1(G)] ;put error number in RH E+1
JRST MRETN
OPENFR: MOVEI B,1
CAIN A,OPNX2 ;no such file
SOJA B,LOOKR2
CAIN A,OPNX3 ;read protected
AOJA B,LOOKR2
JRST LOOKRX ;unexpected error
ER0: TRZA B,-1
ER4: MOVEI B,4
JRST LOOKR2
ER5: MOVEI B,5
JRST LOOKR2
;GETLNK LNK1 LNK2 LNKEND LNKEN1 NSF1 NSF2
; Hairy CCA linking stuff
IFN LINKP,<
GETLNK: SETOM LINKS ; only pass this way once!
SETZM LNKBP
MOVE 1,[LNKBP,,LNKBP+1]
BLT 1,LNKBP+NLINKS-1
HRROI 1,[ASCIZ/LIBRARY/]; <LIBRARY> is always searched
MOVEM 1,LNKBP
HRROI 1,[ASCIZ/MISC/] ; ditto for <MISC>
MOVEM 1,LNKBP+1
MOVEI 5,NRLNKS ; set up the index early
MOVSI 1,100001
HRROI 2,[ASCIZ/[!!-L-I-N-K-S-!!].AFTER/]
GTJFN
POPJ P, ; if there isn't such a file don't worry
MOVEM 1,LNKJFN ; otherwise try reading the links
MOVE 2,[7B5!1B19] ; 7 bit bytes (ASCII), read only
OPENF
JRST NSF1 ; couldn't be opened?
HRROI 2,LNKST ; the string space
LNK1: MOVEM 2,LNKBP(5) ; save first one
MOVE 1,LNKJFN
MOVEI 3,↑D39 ; only allow 39 chars
MOVEI 4,"," ; comma
SIN
CAIN 3,↑D39 ; was anything read?
JRST LNKEND ; nope, forget this one
LDB 3,2 ; what is there?
CAIE 3,","
JRST LNK2
MOVEI 3,0
DPB 3,2 ; make sure it ends with a null
LNK2: HRROI 2,1(2) ; make sure we're on a word boundry
ADDI 5,1 ; bump byte pointer index
CAIE 5,NLINKS ; only allow n links of directories
JRST LNK1 ; still okay
BIN ; beyond link table, see if still more characters
GTSTS ; now get status
TLNN 2,1000 ; hit the EOF?
JRST NSF2 ; oh foo, the file is too big
JRST LNKEN1 ; now close off
LNKEND: SETZM LNKBP(5) ; forget last pointer; nothing was read
LNKEN1: MOVE 1,LNKJFN
HRLI 1,400000 ; release the JFN
CLOSF
JFCL ; who cares if it fails
POPJ P, ; get lost
NSF1: SKIPA 1,[-1,,[ASCIZ/
% Can't OPENF links file
/]]
NSF2: HRROI 1,[ASCIZ/
% Too many links; extra ones ignored
/]
PSOUT
JRST LNKEN1
;GNLNK GNLNK1 GNDONE
; More hairy links stuff for CCA
GNLNK: MOVEI 5,0 ; index for link byte pointers
GNLNK1: CAIL 5,NLINKS ; must be less than NLINKS times
POPJ P, ; gone through all of them
MOVE 1,LNKBP(5) ; next directory to link to
JUMPE 1,GNDONE ; all done if zero
MOVEM 1,JBLOCK+3 ; directory pointer
MOVEI 1,JBLOCK ; file name block
HRROI 2,XFILEN ; default name string
GTJFN
AOJA 5,GNLNK1 ; not found there either, keep looking
POP P,5 ; throw away original return
POP P,5 ; restore 5-3
POP P,4
POP P,3
SUB P,[2,,2] ; don't restore 2-1
POP P,0 ; get back 0
GNDONE: POPJ P, ; go to the proper place
; ULOOK if success
; LOOKER if fail
>;IFN LINKP
;LUKPAR LUKPR5 LUKPR3 LUKPR2 LUKPR4 LUKPR1
;Translate LOOKUP and ENTER parameters to strings
LUKPAR: TRZ PF,R.TMPX ;not TMP extension (yet)
HRRZ G,FORTY ;pointer to parameter block
UMOVE D,(G) ;name in sixbit
TLNN D,-1 ;is left half zero?
CAIGE D,3 ;and right half >= 3?
TRZA PF,R.UEXT ;no, clear flag.
TRO PF,R.UEXT ;yes - indicate extended ENTER block
PUSHJ P,DEV67 ;convert device name to seven bit
HRROI E,XFILEN ; where to build main string
SETZM JBLOCK+4 ; make sure no garbage
PUSHJ P,PARXCT ;get the filename from LOOKUP block
MOVE D,0(G) ;word 0 of short block
MOVE D,2(G) ;or word 2 of long block
MOVEM D,FILNAM(BB) ;save the sixbit filename
PUSHJ P,SIXTO7
SETZM JBLOCK+5 ; no default extension
MOVEI D,"." ; to make the extension
DPB D,E
PUSHJ P,PARXCT ;get the extension from user
HLLZ D,1(G) ;short block
HLLZ D,3(G) ;long block
MOVEM D,EXT(BB) ;save the sixbit version
CAMN D,[SIXBIT /TMP/] ;temporary file?
TRO PF,R.TMPX ;yes, make ;T in Tenex version
PUSHJ P,SIXTO7
PUSHJ P,PARXCT ;get directory number (PPN)
MOVE 2,3(G) ;short form
MOVE 2,1(G) ;long form
PUSHJ P,CHKDIR ;translate sixbit dir to number
SETZM JBLOCK+3 ;we might not have one
SETZM DIRNUM(BB) ;assume own directory
JUMPLE 2,LUKPR2 ;if none given, leave null for GTJFN
HRRZS 2 ;just the directory number
HRROI 1,DIRNAM ;directory name string storage
DIRST ;convert to string
JRST LUKPR2 ;wrong number, leave 0
HRRZM B,DIRNUM(BB) ;store directory number
MOVEI A,NSPDDV-1 ;number of special devices
MOVE D,DEVNAM(BB) ;get device name
CAMN D,SPDDVT(A) ;check for special device
JRST LUKPR5 ;handle special if so
SOJGE A,.-2 ;keep looking
MOVS A,D ;device name swapped
CAIN A,'DSK' ;disk
LUKPR5: CAIE B,1 ;and MFD PPN?
JRST LUKPR3 ;no
MOVS D,EXT(BB) ;yes, and extension .UFD?
CAIE D,'UFD'
JRST LUKPR3 ;no
HRLZI A,'DSK' ;change device to disk
MOVEM A,DEVNAM(BB)
MOVE A,[ASCIZ /DSK/] ;7 bit name too
MOVEM A,DEVNM7
JRST MAKUFD ;yes, go build a UFD
LUKPR3: HRROI E,DIRNAM
MOVEM E,JBLOCK+3 ;pointer for GTJFN
LUKPR2: HRROI E,DEVNM7
MOVEI B,NSPDDV-1 ;number of disk devices
MOVE D,DEVNAM(BB) ;get device name
CAMN D,SPDDVT(B) ;check for special device
JRST LUKPR4 ;handle special if so
SOJGE B,.-2 ;loop looking
JRST LUKPR1 ;std device--handle
LUKPR4: HRRO E,SPDDVN(B) ;get name of device
MOVEM E,JBLOCK+3 ;save for GTJFN
HRROI E,[ASCIZ /DSK/] ;and use device DSK
LUKPR1: MOVEM E,JBLOCK+2
MOVE E,[XWD 377777,377777]
MOVEM E,JBLOCK+1
POPJ P,
;MAKUFD MAKUF1 MAKUF2
;Here when requested to read a UFD. Make one for him, containing
;all files with legal 10/50 filenames, and open that instead.
MAKUFD: HRROI A,STRNG1 ;temp area
MOVEI B,"<" ;make string <DIR>*.* for later user
BOUT
MOVE B,FILNAM(BB) ;PPN of directory user wants
TLZ B,1 ;allow 1 in LH, DIR# in RH
DIRST
JRST LUKPR3 ;no such dir (normal processing will catch)
HRROI B,[ASCIZ />*.*/] ;ok, complete string used later
SETZ C,
SOUT
HRROI A,XFILEN ;build name for temp UFD file
HRROI B,[ASCIZ /[001⊗,/] ; [001,DIR#].UFD (name .gt. 7 chars)
SOUT
HRRZ B,FILNAM(BB)
MOVEI C,10
NOUT
PUSHJ P,ERROR
HRROI B,[ASCIZ /].UFD/]
SETZ C,
SOUT
MOVSI A,(1B0+1B5+1B8) ;output, temporary, ignore deleted
MOVEM A,JBLOCK ;for GTJFN
MOVE A,[377777,,377777] ;use all the defaults
MOVEM A,JBLOCK+1
MOVEI A,JBLOCK ;get a JFN for the UFD
HRROI B,XFILEN
GTJFN
PUSHJ P,ERROR
PUSH P,A ;save JFN
MOVE B,[↑D36B5+1B20] ;open for write, 36 bit
OPENF
PUSHJ P,ERROR
HRROI B,STRNG1 ;now get a JFN for the desired dir
MOVSI A,(1B2+1B11) ;old file, "*" allowed
GTJFN
JRST MAKUFE ;can't, might be empty dir
MOVE D,A ;save indexable JFN
;Loop to make UFD entries for files with legal 10/50 names
MAKUF1: SETZB E,F ;E used for name, F for ext
MOVE A,[POINT 6,E] ;byte ptr to build name
MOVSI C,(1B8) ;JFNS arg to output just name
PUSHJ P,FLDCNV ;convert Tenex name to 10/50 name
JRST MAKUF2 ;not legal 10/50 name, skip it
MOVE A,[POINT 6,F,17] ;byte ptr to build ext in RH of F
MOVSI C,(1B11) ;JFNS arg to output just ext
PUSHJ P,FLDCNV ;convert Tenex ext to 10/50 ext
JRST MAKUF2 ;can't, skip it
MOVE A,(P) ;get JFN for UFD being constructed
MOVE B,E ;output name word
BOUT
HRLZ B,F ;output ext word (leave file ptr zero)
BOUT
MAKUF2: MOVE A,D ;get JFN for next file in dir
GNJFN
JRST MAKUF3 ;no more
JRST MAKUF1 ;more, continue loop
;MAKUFE MAKUF3 FLDCNV FLDCN1
;MAKUFD (continued)
;Here if the GTJFN for <DIR>*.* failed.
MAKUFE: CAIE A,GJFX32 ;"* for name in empty dir"
PUSHJ P,ERROR ;no (any other legit errors???)
;Here when no more files in dir
MAKUF3: POP P,A ;restore output JFN
CLOSF ;close file to make it exist
PUSHJ P,ERROR
JRST LUKPR2 ;exit LUKPAR routine
;Routine to convert field (name or ext) in Tenex filename to a
;legal 10/50 field if possible
; A/ 6bit byte ptr for 10/50 name
; C/ JFNS arg word for field desired
; D/ JFN for Tenex filename being converted
; PUSHJ P,FLDCNV
; error--non-6bit char or overflowed word pointed to by A
; Ok--6bit field stored where indicated
FLDCNV: PUSH P,A ;save output byte ptr
HRROI A,STRNG1 ;temp region for Tenex string
HRRZ B,D ;JFN for filename being converted
JFNS ;convert to string
POP P,A ;get back output byte ptr
MOVE C,[POINT 7,STRNG1] ;set byte ptr to Tenex name
FLDCN1: ILDB B,C ;get char from Tenex name
JUMPE B,CPOPJ1 ;skip return if end of string
CAIN B,"V"-100 ;control-V?
ILDB B,C ;yes, quote next char
SUBI B,40 ;convert ASCII to SIXBIT
JUMPL B,CPOPJ ;control char, can't convert
CAIGE B,100 ;legal sixbit?
TLNN A,(77B5) ;still room in 10/50 name?
POPJ P, ;no, fail
IDPB B,A ;yes, put char in 10/50 name
JRST FLDCN1 ;loop
;SPDDVT SPDSYS NSPDDV SPDDVN CHKDIR
; SPDDVT--Table of special devices for disk. These all refer
; to various std directories with DSK: as the device. The
; current ones are:
;
; DCS: <DECSOURCES>
; DEC: <DECSYS>
; OLD: <OLDSYS>
; NEW: <NEWSYS>
; USE: <USESYS>
; LIB: <LIBRARY>
; HLP: <DOC>
; SUP: <SYSSUP>
; SYS: <SUBSYS>
;
;Warning: This table should never be empty!!!
SPDDVT: ;sixbit device names
IFN SPDDEV,<
SIXBIT /DCS/
SIXBIT /DEC/
SIXBIT /OLD/
SIXBIT /NEW/
SIXBIT /USE/
SIXBIT /LIB/
>;SPDDEV
SIXBIT /HLP/
SIXBIT /SUP/
SPDSYS: SIXBIT /SYS/
NSPDDV== .-SPDDVT ;number of such devices
SPDDVN: ;table of directory names
IFN SPDDEV,<
POINT 7,[ASCIZ /DECSOURCES/]
POINT 7,[ASCIZ /DECSYS/]
POINT 7,[ASCIZ /OLDSYS/]
POINT 7,[ASCIZ /NEWSYS/]
POINT 7,[ASCIZ /USESYS/]
POINT 7,[ASCIZ /LIBRARY/]
>;SPDDEV
POINT 7,[ASCIZ /DOC/]
POINT 7,[ASCIZ /SYSSUP/]
POINT 7,[ASCIZ /SUBSYS/]
; CHKDIR--Check directory for being sixbit and if so, change
; first to ASCII then to Tenex number (w/ recognition).
;
CHKDIR:
IFE SIXPPN,<
TLNN B,770000 ;check for sixbit name
POPJ P, ;not--use as is
>;IFE SIXPPN
IFN SIXPPN,<
HLRZ D,B ;isolate proj
CAIE D,1 ;one
CAIN D, ; or zero
POPJ P, ;is use as is, else must be sixbit
>;IFN SIXPPN
PUSH P,B ;save old value
MOVE D,B ;sixbit to D
HRROI E,DIRNAM ;string ptr to E
PUSHJ P,SIXTO7 ;convert to ASCII
MOVSI 1,400000 ;negative num w/o B17
HRROI 2,DIRNAM ;ptr to name
STDIR ;get directory number
JFCL ;fail or
SKIPA A,0(P) ; ambiguous yields initial
HRRZS A ;if ok, isolate directory number
POP P,B ;fix stack
MOVE B,A ;get result to return
POPJ P, ;and done
;UENTER UENT1 ENTR3 ENTER1 ENTR4 ENTR41 ENTRER
UENTER: PUSHJ P,SETUP
MOVE D,FLAGWD(BB)
TLNN D,INITF
PUSHJ P,ERRCHN
PUSHJ P,DIRCHK ;directory type device?
JRST MRETN2 ;no, nop.
MOVE A,DEVTBL(AA) ;device bits
TLNN A,DSKDEV ;a disk?
JRST UENT1 ;no
MOVE A,FLAGWD(BB) ;yes, get its status
TLNN A,IOPENF ;file already open for input?
JRST UENT1 ;no
MOVEI B,3B20 ;yes, want to update, set write also
JRST ENTR41 ;go do it.
UENT1: SETZM IOCNT ;prepare for close
PUSHJ P,UCL1R ;close and release JFN
MOVEI D,17
AND D,FLAGWD(BB)
MOVE B,DEVTBL(AA)
TLNE B,DTADEV ;DECtape in buffered mode?
CAILE D,14 ;or DSK?
TLNE B,DSKDEV
JRST ENTR3 ;yes- do GTJFN now
SKIPN A,JFNTAB(BB) ;have a JFN already?
PUSHJ P,ERRCHN ;no
JRST ENTR4 ;yes, go open it.
ENTR3: PUSHJ P,LUKPAR ;set up same parameters as LOOKUP
UMOVE D,(G)
JUMPE D,ER0 ;zero file name for ENTER
MOVSI D,IOPENF
TDNE D,FLAGWD(BB) ;file OPENF for reading already?
PUSHJ P,ERRARG
MOVSI E,400000
REPEAT 0,< ;this idea doesn't work with STOPGAP...(sigh)
TRZE PF,R.TMPX ;was extension "TMP"?
TLO E,(1B5) ;yes, make ;T file
>;REPEAT 0
ENTER1: MOVEM E,JBLOCK
HRROI B,XFILEN ;primary string pointer
MOVEI A,JBLOCK
GTJFN
JRST ENTRER
MOVEM A,JFNTAB(BB) ;save gotten JFN
PUSHJ P,ENTPAR ;set file params from ENTER block
ENTR4: MOVEI B,1B20 ;open for writing
ENTR41: PUSHJ P,OPENX
MOVSI A,OOPENF!ENTERF
IORM A,FLAGWD(BB)
JRST MRETN2
ENTRER: MOVEI B,2 ;assume protection error
CAIN A,GJFX17 ;check it
SOJA B,LOOKR2 ;directory not found
JRST LOOKR2 ;protection error
;URENME
URENME: PUSHJ P,SETUP
MOVE D,FLAGWD(BB)
TLNN D,INITF
PUSHJ P,ERRCHN
PUSHJ P,DIRCHK ;directory device?
JRST MRETN2 ;no
MOVSI A,LOOKPF!OOPENF!ENTERF
TDNN A,FLAGWD(BB)
JRST ER5 ;no file previously selected
SETZM IOCNT ;do a CLOSE if needed
PUSHJ P,UCL1K ; ..
TRZ PF,R.UEXT ;assume not extended RENAME
HRRZ AA,FORTY
UMOVE D,(AA) ;get first word of arg block
JUMPE D,RENDEL ;if name is 0, RENAME to null = delete
TLNN D,-1 ;short or long form name block?
TRO PF,R.UEXT ;long form RENAME (FOROTS does these)
TRNE PF,R.UEXT ;which form?
UMOVE D,2(AA) ;long, get the name
JUMPE D,RENDEL ;if name is 0, RENAME to null = delete
MOVE A,FILNAM(BB) ;save old file name
MOVEM A,BUFFER ; ..
MOVEM D,FILNAM(BB) ;set new file name
HRROI E,FILNM7 ;storage for ASCIZ of new one
PUSHJ P,SIXTO7 ;convert new file name
MOVE A,FILNAM(BB)
CAME A,BUFFER
JRST RENME1 ;name differs
MOVE A,EXT(BB)
MOVEM A,BUFFER ;save old extension
PUSHJ P,PARXCT ;get the ext
HLLZ D,1(AA) ;short form
HLLZ D,3(AA) ;long form
MOVEM D,EXT(BB) ;store the sixbit extension
HRROI E,EXT7 ;string storage for ASCIZ ext
PUSHJ P,SIXTO7 ;convert new ext
MOVE A,EXT(BB)
CAME A,BUFFER
JRST RENME2 ;extension differs
;protection change only
MOVE A,FLAGWD(BB) ;get file flag word
TLNN A,ENTERF ;is the thing open for output
JRST MRETN2 ;do not try to change protection
;This is for FORTRAN it tries to set protection on CLOSE.
JRST RENME4 ;just update params - don't RENAME
;Note - doesn't RENAME across directories....
;RENME1 RENME2 RENME3 RENME4 RENDEL
RENME1: PUSHJ P,PARXCT ;get extension
HLLZ D,1(AA) ;short form
HLLZ D,3(AA) ;long form
MOVEM D,EXT(BB) ;store new ext, sixbit
HRROI E,EXT7
PUSHJ P,SIXTO7
RENME2: PUSHJ P,PARXCT ;get directory
MOVE B,3(AA) ;short form
MOVE B,1(AA) ;long form
PUSHJ P,CHKDIR ;check for sixbit directory
MOVE D,B ;set up for the rest
SKIPGE D ;user supply a proj-prog number?
MOVEI D,0 ;no.
TLNE D,-2 ;yes, project 0 or 1?
JRST MRETN ;no, can't translate it.
HRRZM D,DIRNUM(BB) ;yes, store Tenex directory number
MOVSI A,600000 ;new file only for output
MOVEM A,JBLOCK
MOVE A,[XWD 377777,377777] ;no string
MOVEM A,JBLOCK+1
PUSHJ P,DEV67 ;convert the device name to ASCIZ
HRROI A,DEVNM7 ;pointer to the ASCIZ
MOVEM A,JBLOCK+2
SETZM JBLOCK+3 ;in case no dir name
SKIPG B,DIRNUM(BB)
JRST RENME3
HRROI A,DIRNAM
DIRST ;make it into a name
JRST MRETN ;he doesn't exist (should give code 1)
HRROI A,DIRNAM ;pointer to name in ASCIZ
MOVEM A,JBLOCK+3
RENME3: HRROI A,FILNM7
MOVEM A,JBLOCK+4
HRROI A,EXT7
MOVEM A,JBLOCK+5
SETZM JBLOCK+6
SETZM JBLOCK+7
SETZM JBLOCK+10
MOVEI B,0 ;no primary string
MOVEI A,JBLOCK
GTJFN
JRST MRETN ;error return
PUSH P,A
MOVE A,JFNTAB(BB) ;old JFN
TLO A,400000 ;don't release it
CLOSF ;be sure file is closed
JFCL
MOVE A,JFNTAB(BB) ;old JFN
POP P,B ;new JFN
RNAMF
PUSHJ P,ERROR
MOVEM B,JFNTAB(BB) ;new JFN
RENME4: HRRZ G,AA ;set file params from ENTER block
PUSHJ P,ENTPAR ; ..
JRST MRETN2
RENDEL: MOVE A,JFNTAB(BB) ;zero file name on RENAME, ie delete
DELF
PUSHJ P,ERROR
PUSHJ P,UREL2 ;DELF releases its argument
JRST MRETN2
;PARXCT ENTPAR ENTPR1
;Routine for referencing LOOKUP/ENTER blocks that might be extended.
; PUSHJ P,PARXCT
; inst to execute if short LOOKUP/ENTER
; inst to execute if EXTENDED LOOKUP/ENTER
; always return here
PARXCT: TRNN PF,R.UEXT ;extended?
XCTUU @0(P) ;no, do first instruction
AOS 0(P) ;skip over it
TRNE PF,R.UEXT ;which kind again?
XCTUU @0(P) ;extended, do second inst
JRST CPOPJ1 ;skip it and return
;Routine to set file parameters as appropriate from ENTER or
;RENAME block. Expects G to point to block.
ENTPAR: PUSHJ P,PARXCT ;get the protection word
MOVE A,2(G) ;short form, it's here
MOVE A,4(G) ;long form, it's here.
TLNN A,(777B8) ;explicit protection set?
JRST ENTPR1 ;no
PUSHJ P,TNXPRT ;yes, translate to Tenex prot value
MOVE A,JFNTAB(BB) ;set it
HRLI A,4 ;in FDB
MOVEI B,-1 ;in this part of word
CHFDB
ENTPR1: ;Here we want to set the creation date/time if non-zero,
;but Tenex doesn't normally do that, so we won't.
POPJ P,
;TNXPRT T50PRT PRTTAB
;Routine to translate DEC protection to Tenex protection.
;Call with DEC protection in B0-B8 of A.
;Returns Tenex protection in RH of C.
TNXPRT: SETZ C,0 ;initial Tenex prot
PUSHJ P,.+2 ;recurse!
PUSHJ P,.+1 ;again!
HRRI A,0 ;clear the preceeding 10/50 byte
ROT A,3 ;bring in the next one
HLR A,PRTTAB(A) ;pick up corresponding Tenex prot
LSH C,6 ;shift it into Tenex prot
IORI C,(A) ; ..
POPJ P,
;Routine to map Tenex prot's into DEC prot's.
;Call with Tenex prot in RH of A, get back 10/50 prot in B0-B8 of C.
T50PRT: SETZ C,0 ;init the DEC prot.
PUSHJ P,.+2 ;recurse for the three fields
PUSHJ P,.+1 ; ..
HRRI C,7 ;assume max protection
MOVEI B,7 ;and table index of 7
TDNE A,PRTTAB(B) ;this access avail in Tenex prot?
HRRI C,(B) ;yes, reduce DEC prot field accordingly
SOJGE B,.-2 ;iterate thru table
LSH A,-6 ;done, shift out Tenex prot field.
ROT C,-3 ;save field of 10/50 answer
POPJ P,
;Table which defines translation between the DEC and Tenex protections.
;Index by DEC prot, LH gives nearest equivalent Tenex prot. Note
;that file modification and execute only protections really mean quite
;different things on the two systems.
;Mapping from Tenex to DEC is many-to-few, so only the most common
;will be "right". The RH of this table gives Tenex access bits that
;will be mapped into the DEC protection given by that index into the
;table. The DEC protection chosen will be the one with greatest
;access (=lowest numerical protection)
PRTTAB: 77,,20 ;(0) change protection
77,,00 ;(1) rename
77,,00 ;(2) supercede
77,,00 ;(3) update
56,,04 ;(4) append
52,,40 ;(5) read
12,,12 ;(6) execute (include "per page table" in Tenex)
00,,00 ;(7) no access allowed
;UCLOSE UCL1K UCL1R UCL2 UCL4 UCL3
UCLOSE: PUSHJ P,SETUPG
JRST MRETN ;nothing to be open, return immediately
MOVE A,FORTY ;move close bits
MOVEM A,IOCNT ;to where UCL1 will see them
PUSHJ P,UCL1K ;close, keeping JFN
JRST MRETN
UCL1K: TROA PF,R.KJFN ;keep the JFN
UCL1R: TRZ PF,R.KJFN ;release the JFN
MOVEI B,1
TDNE B,IOCNT ;close output?
JRST UCL2 ;no
PUSH P,IOCNT
PUSH P,FORTY
SETZM FORTY
MOVSI B,OOPENF
MOVEI A,17
AND A,FLAGWD(BB)
CAIG A,14 ;buffered mode?
TDNN B,FLAGWD(BB) ;and open for output?
SKIPA ;no, all done
PUSHJ P,OUTTN ;if open for writing, do last out
JFCL ;pity
POP P,FORTY
POP P,IOCNT
LDB AA,PDVNUM ;what kind of device?
MOVE A,FLAGWD(BB) ;and current flags
MOVE B,DEVTBL(AA)
TLNE A,OOPENF ;if open for output,
TLNN B,MTADEV ;and it's a magtape,
JRST UCL2 ; (no -- done)
IFN MTWEOF,<
MOVE B,DEVNAM(BB) ;device name
SETZ A, ;assume unit zero
CAME B,[SIXBIT /MTA0/]
MOVEI A,1 ;must be MTA1
SKIPN MTAWR(A) ;has it been written?
JRST UCL2 ;no, IMSSS prefers not to write EOT
SETZM MTAWR(A) ;clear write flag on gp
>;MTWEOF
MOVE A,JFNTAB(BB) ;yes, need to put EOT on tape
MOVEI B,3
MTOPR ;write two EOF's
MTOPR ; ..
MOVEI B,7 ; and back up over one of them.
MTOPR
UCL2: MOVEI B,2 ;closing input side?
TDNN B,IOCNT ; ..
SKIPG MAPTAB(BB) ;yes, have a page mapped?
JRST UCL4 ;no.
MOVEI B,(BB) ;reconstruct page number.
IDIVI B,NTABS ;from table offset
MOVEI B,IOMPGS(B) ;page number.
HRLI B,.S ;in this fork
SETOB A,MAPTAB(BB) ;to ovlivion
PMAP ;clear it out
UCL4: MOVE B,FLAGWD(BB)
MOVE A,IOCNT
TRNN A,1 ;closing output?
TLZ B,OOPENF ;yes
TRNN A,2 ;closing input?
TLZ B,IOPENF ;yes
HRRZ A,JFNTAB(BB)
TLNE B,OOPENF+IOPENF ;both sides now closed?
JRST UCL3 ;no
JUMPE A,UCL3 ;yes, got a JFN?
CAIE A,PRIJFN ;other than primary?
CAIN A,PROJFN ; ..
JRST UCL3 ;no.
TRNE PF,R.KJFN ;keeping JFN?
TLO A,.S ;yes, set sign bit for CLOSF
CLOSF ;close it
JFCL ;multiple close is nop
SKIPE A,JFNTAB(BB) ;don't release JFN if it is zero
TRNE PF,R.KJFN ;or caller said keep it
JRST UCL3
RLJFN
PUSHJ P,ERROR
SETZM JFNTAB(BB)
UCL3: MOVEI A,2 ;B34
TDNN A,IOCNT ;omit input side?
PUSHJ P,CLOSEI ;nah, close it
MOVEI A,1 ;B35
TDNN A,IOCNT
JRST CLOSEO
POPJ P,
;CLOSEI CLOSI2 BUFLP CLOSEO DIRCHK DEV67
CLOSEI: MOVSI B,IOPENF+INFIRF
HRRZ A,BUFHTB(BB) ;ptr to input buffer header
CLOSI2: TDNN B,FLAGWD(BB)
POPJ P,
TRO B,1B22 ;clear EOF.
ANDCAB B,FLAGWD(BB)
ANDI B,17
CAIE A,0 ;is there a buffer?
CAILE B,14 ;and in buffered mode?
POPJ P, ;no
MOVSI B,400000 ;close a buffer ring
XCTUU [SKIPE (A)] ;has buffer ring been set up?
XCTUU [TDNE B,(A)] ;and has it been used?
POPJ P, ;no, forget it
XCTUU [IORB B,(A)]
XCTUU [SETZM 2(A)] ;clear byte count
MOVEI D,(B) ;extra copy for end test
BUFLP: MOVEI C,(B)
CAMLE C,JBREL ;are ring link pointers ok?
PUSHJ P,ERRARG ;no, smashed somehow
MOVSI B,400000
XCTUU [ANDCAB B,(C)] ;clear buffer use bit and fetch chain pointer
CAIE D,(B) ;back around to first one in ring?
JRST BUFLP ;no
POPJ P,
CLOSEO: MOVSI B,OOPENF+OUFIRF
HLRZ A,BUFHTB(BB)
JRST CLOSI2
DIRCHK: MOVE B,JFNTAB(BB) ;is this primary I/O?
CAIE B,PRIJFN ; ..
CAIN B,PROJFN ; ..
POPJ P, ;yes, pretend can't RENAME, etc.
MOVE B,DEVTBL(AA) ;get device bits
TLNE B,HASDIR ;have a directory?
AOS (P) ;yes, skip return
POPJ P, ;return.
DEV67: MOVE D,DEVNAM(BB) ;get the sixbit name
HRROI E,DEVNM7 ;where ASCIZ should get put
JRST SIXTO7 ;convert it.
;SETUP SIXTO7 SIXT7A SIXT7B SPECCH SETUPG
;Setup on entry to I/O UUO's
SETUP: PUSHJ P,SETUPG ;call conditional setup routine
PUSHJ P,ERRCHN ;not open, error.
POPJ P, ;okay
;Conversion from sixbit to ASCIZ
;C - clobberable
;D - sixbit thing to convert
;E - pointer to destination
SIXTO7: TLC E,-1 ;only change if default -1
TLCN E,-1 ;is it?
HRLI E,440700 ;assume ASCIZ's start on word boundary
JUMPE D,SIXT7B ;quit if string empty
SIXT7A: MOVEI C,0
ROTC C,6 ;put one char into C
JUMPE C,SIXT7A ;delete leading nulls
ADDI C,40 ;offset
CAIE C,"."
CAIN C,":"
PUSHJ P,SPECCH
CAIE C,";"
CAIN C,"<"
PUSHJ P,SPECCH
CAIE C,">"
CAIN C,"="
PUSHJ P,SPECCH
CAIE C,"@"
CAIN C,"*"
PUSHJ P,SPECCH
CAIE C,"←"
CAIN C,40
PUSHJ P,SPECCH
IDPB C,E ;store away
JUMPN D,SIXT7A ;any more chars in thing?
SIXT7B: IDPB D,E ;store a zero terminator
POPJ P,
SPECCH: PUSH P,C
MOVEI C,"V"-100 ;use cntl-V to quote it
IDPB C,E
POP P,C
POPJ P,
SETUPG: MOVE BB,AC ;channel number
IMULI BB,NTABS
LDB AA,PDVNUM ;get numeric device type
SKIPE DEVNAM(BB) ;something of a crock.
AOS (P)
POPJ P,
;UUSETO UUSETI UUSET1
UUSETO: TROA PF,R.DIRN ;flag USETO vs USETI
UUSETI: TRZ PF,R.DIRN ;USETI vs USETO
PUSHJ P,SETUP
CAIN AA,3 ;is it DECtape?
JRST DTASET ;yes
PUSHJ P,PTRGET
JRST MRETN ;no good
MOVE C,B ;number of bytes in file
MOVEI B,1B22 ;clear EOF flag
ANDCAM B,FLAGWD(BB) ;if it exists
HRRZ B,FORTY ;buffer number
SOJGE B,.+2
SETZ B,
IMUL B,DEVTB2(AA) ;buffer size
TRNN PF,R.DIRN ;output?
CAIGE B,0(C) ;no, input beyond EOF?
JRST UUSET1 ;no
SETO 2, ;set file ptr to EOF
SFPTR
PUSHJ P,ERROR ;ooops
MOVEI A,1B22 ;input, EOF flag set
IORM A,FLAGWD(BB)
JRST MRETN
UUSET1: SFPTR
PUSHJ P,ERROR ;no good
JRST MRETN
;PTRGET UUGETF DTASET DTAST2
PTRGET: PUSHJ P,DIRCHK ;directory device?
POPJ P, ;no, no-op
MOVE A,FLAGWD(BB) ;channel flags
TLNE A,LOOKPF!ENTERF ;must be looked up or ENTERed
TLNN A,OOPENF!IOPENF ;and open for input or output
PUSHJ P,ERRARG ;error
MOVE A,JFNTAB(BB)
;Note - following in place of SIZEF which fails if file never closed.
RFPTR ;where are we in file?
PUSHJ P,ERROR
PUSH P,B ;save it
SETO B, ;request current EOF
SFPTR ; ..
PUSHJ P,ERROR
RFPTR ;file where that is
PUSHJ P,ERROR
EXCH B,(P) ;save answer
SFPTR ;restore to where we were at call
PUSHJ P,ERROR ;can't fail...
POP P,B ;return the length of file
AOS (P) ;skip return
POPJ P,
UUGETF: PUSHJ P,SETUP ;get AA and BB
PUSHJ P,PTRGET ;first free word
JRST MRETN
IDIV B,DEVTB2(AA)
SKIPE C ;first word of buffer?
ADDI B,1 ;no, go to next buffer
HRRZ A,FORTY ;target address
UMOVEM B,(A)
JRST MRETN
DTASET: MOVE C,FLAGWD(BB)
TLNE C,OOPENF!IOPENF ;is it open?
JRST DTAST2 ;yes.
MOVE A,JFNTAB(BB) ;no, open it
MOVE B,[XWD 447400,300000] ;in dump mode
OPENF
PUSHJ P,ERROR
MOVSI B,OOPENF!IOPENF
IORM B,FLAGWD(BB) ;mark it as open
DTAST2: MOVE A,JFNTAB(BB)
MOVEI B,30 ;declare block for dump I/O
ANDI C,17 ;TEN50 init mode field
CAIE C,17 ;dump mode?
MOVEI B,6 ;no, skip some records.
HRRZ C,FORTY ;block to position to
MTOPR
JRST MRETN
;UMTAPE MTAPE2 MTAPE3 MTAPE1 MTAPE4
UMTAPE: PUSHJ P,SETUP
MOVE A,FLAGWD(BB) ;is it INIT'ed?
TLNN A,INITF
PUSHJ P,ERRCHN
CAIE AA,2 ;is device a magtape?
JRST MRETN ;no, nop
SKIPE A,JFNTAB(BB) ;has it a JFN?
JRST MTAPE2
PUSHJ P,JBKSET ;initialize JBLOCK
PUSHJ P,DEV67 ;move the name to ASCIZ block
HRROI A,DEVNM7 ;pointer to it.
MOVEM A,JBLOCK+2 ;device name MTAx
MOVSI A,400000 ;for ouuput
MOVEM A,JBLOCK
SETZ B,
MOVEI A,JBLOCK
GTJFN
PUSHJ P,ERROR
MOVEM A,JFNTAB(BB)
MTAPE2: GTSTS
JUMPGE B,MTAPE3 ;jump if not yet opened
PUSHJ P,MTAPE1
JRST MRETN
MTAPE3: MOVE B,[XWD 447400,300000] ;open in dump mode
OPENF
PUSHJ P,ERROR
PUSHJ P,MTAPE1
HRLI A,400000 ;opened if only to do the MTOPR.
CLOSF
PUSHJ P,ERROR
JRST MRETN
MTAPE1: HRRZ B,FORTY ;get command
IFN IMSSS,< ;IMSSS has some funny tape stuff...
TRNN B,100 ;mode set operation or
CAIN B,2 ; density set to 800BPI?
JRST MTAPE4 ;yes
CAIN B,12 ;density set to 1600BPI?
JRST MTAPE4 ;yes
>;IFN IMSSS
MTOPR ;do it
CAIN B,1 ; rewind to load point?
MTOPR ;yes, do again to force status bits
POPJ P,
IFN IMSSS,< ;special IMSSS magtape code
MTAPE4: MOVE D,B ;save user operation
GDSTS ;get device status into B
TRNE D,100 ;mode set operation?
TRZA B,1B26 ;clear to institute dump mode (100,101)
TRZ B,3B28 ;set to 1600 BPI (2 or 12)
CAIN D,2 ;want 800 BPI?
IORI B,3B28 ;yes, force 800 (otherwise 12, want 1600)
CAIN D,101 ;set to 4 byte?
TRO B,1B26 ;yes, set 4 byte mode (else 1,12,100)
SDSTS
MOVE C,FLAGWD(BB)
TRNN D,100 ;mode set operation?
TRZA C,3B28 ;no, clear density bits since they changed
TRZ C,1B26 ;yes, clear the mode bit
ANDI B,7B28 ;isolate possibly changed bits
IOR B,C ;into status word
HRRM B,FLAGWD(BB)
POPJ P,
>;IFN IMSSS
;UOUT UIN UIOSK UIOSK1 UINPUT UOUTPT JBKSET
;IN, OUT, INPUT, OUTPUT
UOUT: PUSHJ P,OUTT
JRST UIOSK
UIN: PUSHJ P,INN
UIOSK: MOVE A,FLAGWD(BB)
TRNE A,762000 ;data errs, EOF, or EOT?
JRST UIOSK1 ;yes
MOVE A,JFNTAB(BB)
GTSTS
TRNE B,700000
UIOSK1: AOS (P)
JRST MRETN
UINPUT: PUSHJ P,INN
JRST MRETN
UOUTPT: PUSHJ P,OUTT
JRST MRETN
JBKSET: MOVE A,[XWD 377777,377777] ;no files
MOVEM A,JBLOCK+1
SETZM JBLOCK+2 ;system defaults on everything
MOVE A,[XWD JBLOCK+2,JBLOCK+3]
BLT A,JBLOCK+10
POPJ P,
;INN INN3 INN1 INNT INN2
;IN and INPUT operators
INN: PUSHJ P,SETUP
MOVE A,FLAGWD(BB)
TLNE A,IOPENF ;open for input?
JRST INN3 ;yes
MOVEI B,1B19
PUSHJ P,OPENX ;open it for input
MOVSI A,IOPENF
IORB A,FLAGWD(BB) ;mark that fact
INN3: ANDI A,17 ;get mode inited in.
CAIL A,15 ;is it a buffered mode?
JRST INDMP ;no, dump mode
HRRZ CC,BUFHTB(BB) ;buffer header
MOVSI A,INFIRF ;first time flag
TDNE A,FLAGWD(BB) ;is it?
JRST INN2 ;no
IORB A,FLAGWD(BB) ;yes, but not next time ...
TLNN A,OOPENF!OUFIRF ;no mapping if output also
CAIE AA,0 ;or if not on disk
SKIPA
SETOM MAPTAB(BB) ;flag to try mapping input data
INN1: MOVE A,JFNTAB(BB) ;the JFN
SIZEF ;try to get size in bytes of file
JRST INNT ;can't
PUSH P,B ;save it
MOVE B,[XWD 1,11] ;now get byte size from FDB
MOVEI C,C
GTFDB
POP P,B
ROT C,↑D12 ;byte size in bits 6-11
ANDI C,77
CAIE C,07 ;7 bit?
INNT: MOVSI B,200000 ;default byte count is infinity
MOVEM B,BYTCNT(BB) ;will be counted down by input open's
MOVSI A,IOPENF
MOVSI B,INBUFF
MOVEI C,2 ;two buffers
XCTUU [SKIPN 0(CC)] ;buffers set up?
PUSHJ P,IOBUF ;no set up a two buffer ring
XCTUU [SKIPL A,(CC)] ;don't advance buffer the first
INN2: XCTUU [MOVE A,@(CC)] ;advance the buffer
MOVSI B,.S ;sign bit
ANDCAM B,@(CC) ;current buffer is RELEASEd
HRRZ B,FORTY
CAIE B,0 ;specifying new ring?
MOVE A,B ;yes, store its address
XCTUU [HRRZM A,(CC)]
PUSHJ P,INIBUF ;zero buffer and set up ptr and count
MOVE A,JFNTAB(BB)
;INN2A INDSPT INDMP INDM1 INDM3
INN2A: PUSHJ P,@INDSPT(AA) ;setup should set up AA with device number
PUSHJ P,SETIBF ;compute count and set up new ptr
MOVE B,0(CC) ;current buffer address
HRRZ A,FLAGWD(BB) ;file status
UMOVEM A,-1(B) ;store status at beginning of buffer
POPJ P,
INDSPT: EXP INDSK,ITRAP,INMTA,INBYT,INBYT,ITRAP,ITRAP,ITRAP
EXP ITRAP,ITRAP,INTTY,ITRAP,INTTY,INBYT,INBYT,ITRAP
INDMP: MOVE A,JFNTAB(BB) ;JFN
CAIN AA,0 ;device disk?
JRST INDM2 ;yes, simulate DUMPI by SIN
HRRZ B,FORTY ;no, use DUMPI
CAIGE B,20 ;in the AC's?
ADDI B,ACS ;yes, point to them
TRZ PF,R.DIRN ;direction is input (for MTA)
MOVE C,DEVTBL(AA) ;is it a magtape?
TLNE C,MTADEV ; ..
JRST MTALP1 ;yes, treat separately
INDM1: DUMPI
JRST INDMER ;error, see if possible
INDM3: POPJ P,
;INDM2 INCML INDM4 INDM4A
INDM2: HRRZ D,FORTY ;command list pointer
INCML: CAIGE D,20 ;in the ACs?
ADDI D,ACS ;yes, point to stored ACs
MOVE C,(D) ;command loop
JUMPE C,INDM3 ;done on zero command
TLNE C,-1 ;zero left half means go to
JRST INDM4
MOVE D,C
JRST INCML ;get net command
INDM4: HRRI B,1(C) ;first location
HRLI B,444400 ;binary transfer
HLRO C,C ;word count
MOVEM C,MTDUMP ;save counter before I/O
SIN
MOVEM B,SPDELC ;save byte ptr after I/O
GTSTS ;how did it go?
TLNN B,1000 ;EOF?
JRST [ RFPTR ;round to 200 word records
PUSHJ P,ERROR
TRZE B,177
ADDI B,200
SFPTR ;point to next record boundary
PUSHJ P,ERROR
AOJA D,INCML] ;go get new command
CAML C,[-177] ;one or more blocks not read?
;note, real EOF condition is a mess!
JRST INDM4A ;no, no EOF to user yet
MOVEI A,1B22 ;yes, really EOF.
IORM A,FLAGWD(BB) ;set 10/50 EOF bit
JRST INDM3 ;done.
INDM4A: MOVEI A,0 ;clear rest of requested I/O list
MOVE B,SPDELC ;see how much needs clearing
AOJG C,INDM3 ;count up thru 0
IDPB A,B ;need another zero
JRST .-2 ;done yet?
;INDMER INDME1 INDME2 INDME3 DTAX3Q
INDMER: PUSHJ P,DTAX3Q ;see if size error on DTA
PUSH P,B ;yes, stash position of offending IOWD
PUSH P,0(B) ;stash the IOWD on stack
INDME1: MOVSI A,MAXIOL ;see if a K left
ADD A,0(P) ; ..
JUMPG A,INDME2 ;no, should be ready to quit.
MOVSI A,-MAXIOL ;a reasonable size IOWD
HRR A,0(P) ;first part of the big list
MOVEM A,DMPLST ;place to stash I/O list
SETZM DMPLST+1 ;terminate list
MOVE A,JFNTAB(BB) ;ready to do some I/O. get JFN
MOVEI B,DMPLST ;where I/O list is
DUMPI ;try this
PUSHJ P,ERROR ;if this loses, give up.
MOVE A,[XWD MAXIOL,MAXIOL] ;update partial IOWD on stack
ADDM A,0(P) ; ..
JRST INDME1 ;try the rest of iolist
INDME2: POP P,DMPLST ;should be ready to handle this
MOVE A,JFNTAB(BB) ;get the JFN
HLLZ B,DMPLST ;is it by luck empty now?
JUMPE B,INDME3 ;jump if so
MOVEI B,DMPLST
DUMPI ;read it
PUSHJ P,ERROR ;can't
INDME3: POP P,B ;restore place in I/O list
ADDI B,1 ;next word.
SKIPE (B) ;end of list, I hope?
JRST INDM1 ;no, have to try that part of list
JRST INDM3 ;end, quit INDMP subr
DTAX3Q: CAIE A,DUMPX3 ;recoverable length error?
JRST ERROR ;no, give error message
LDB A,PDVNUM ;get device type code.
CAIE A,3 ;DECtape?
JRST ERROR ;nope, lose.
POPJ P, ;yes, return.
;SETIBF SETIB1 SETIB2
;Set buffer for user after input
SETIBF: MOVE B,IOCNT ;bytes not xferred last time
LDB C,[POINT 6,IOBPT,11] ;byte size of xfer
XCTMU [LDB D,[POINT 6,1(CC),11]] ;user's byte size
CAIN C,0(D) ;same?
JRST SETIB1 ;yes
CAIG C,0(D) ;xfer size bigger?
JRST SETIB2 ;no
IDIVI C,0(D) ;xfer size bigger, get ratio
IMUL B,C ;number user-size bytes not xfer'd
SETIB1: MOVN C,B ;B now has number not xferred
XCTUU [SUB B,2(CC)] ;-BUFSIZ gives minus number xferred
ADDB B,BYTCNT(BB) ;countdown bytes in file
CAIGE B,0 ;gone past end?
ADD C,B ;yes, adjust size of last xfer
XCTUU [ADDB C,2(CC)] ;actual bytes xferred to user
MOVE B,C ;bytes
MOVEI C,↑D36 ;bits per word
XCTMU [LDB D,[POINT 6,1(CC),11]] ;user's bits per byte
IDIVI C,(D) ;bytes per word
IDIVI B,(C) ;words
SKIPE C ;and fraction thereof
ADDI B,1
UMOVE C,0(CC) ;current buffer address
XCTMU [HRRM B,1(C)] ;store the word count with buffer
POPJ P,
SETIB2: PUSHJ P,BUGSTP ;shouldn't have done smaller than user,
IDIVI D,0(C) ;but otherwise, this fixes up
IDIV B,D ;byte count
JRST SETIB1
;INTTY INTTY1 INTTD1 INTTY2 INTTEO
INTTY: PUSHJ P,NOCTRO ;clear control-O flag
PUSHJ P,TTYSTS ;set TTY status up
MOVE G,IOCNT ;save full buf count for delete
INTTY1: SOSGE IOCNT
JRST INDON1 ;buffer full
INTTD1: PUSHJ P,TTYBIN ;read a char from TTY
CAIN B,37 ;EOL?
JRST INTTEO
MOVE E,FLAGWD(BB)
TRNE E,1B29 ;transparent mode?
JRST INTTY2 ;yes
CAIE B,177 ;rubout, or
CAIN B,"A"-100 ;control-A?
JRST INTTDC ;deletes character
CAIE B,"U"-100 ;control U?
CAIN B,"X"-100 ;control-X?
JRST INTTDB ;deletes buffer (line)
CAIN B,"R"-100 ;control R?
JRST INTREP ;retypes buffer
IFN STALTP,<
CAIE B,176 ;old altmode?
CAIN B,33 ;or escape?
MOVEI B,STDALT ;yes, change to 10/50 altmode
>;IFN STALTP
INTTY2: XCTMU [IDPB B,IOBPT] ;put it away
CAIN B,"Z"-100 ;EOF?
JRST INTTY8 ;yes
IFN STALTP,<
CAIGE B,175 ;alt, old alt, or rubout?
>;IFN STALTP
IFE STALTP,<
CAIE B,177 ;rubout?
>;IFE STALTP
CAIN B,C.BELL ;or bell?
JRST INTTY9 ;yes, break characters
CAIE B,33 ;escape?
CAIN B,"U"-100 ;or control U?
JRST INTTY9 ;yes, break character.
CAIN B,"R"-100 ;control R
JRST INTTY9 ;yes, break character
CAIL B,12 ;a form control char?
CAILE B,14
JRST INTTY1 ;no, back for another character
JRST INTTY9 ;yes, wake up
INTTEO: MOVEI B,15 ;replace EOL by CRLF
XCT INTTY2
SOS IOCNT ;no end check here, could lose
MOVEI B,12
JRST INTTY2
;INDON1 INTTY8 INTY8A INTTY9 FILWD INTTY7 TTYBIN TTYBPC INTTDB INTDB1
INDON1: AOS IOCNT
JRST INTTY9
INTTY8: PUSHJ P,CRLF ;type CRLF echo
INTY8A: MOVEI A,1B22 ;EOF flag in status word
IORM A,FLAGWD(BB)
INTTY9: MOVSI A,400000 ;buffer use flag
XCTUU [IORM A,@(CC)]
MOVE A,IOCNT
IDIVI A,5 ;does it end on word boundary?
JUMPE B,INTTY7 ;yes, all done.
MOVE A,B
SETZ B,
FILWD: XCT INTTY2 ;fill rest of last word with zeroes
SOS IOCNT
SOJG A,FILWD
INTTY7: POPJ P,
TTYBIN: CAIN A,101 ;is it primary output?
MOVEI A,100 ;yes, make primary input.
TTYBPC=.+1 ;after the bin, for interrupt check
BIN ;get the char from tty
POPJ P, ;return from TTY byte input
INTTDB:
IFN CCA,<
MOVE B,[440700,,[BYTE (7),"U"-100]]
MOVEM B,STRNG1
PUSHJ P,DPYDEL ;delete the ↑U
JRST INTDB1 ;a display, win win!
>;IFN CCA
PUSH P,A ;not a display
HRROI A,[ASCIZ/←←
/]
PSOUT
POP P,A
PUSHJ P,INTDC1 ;delete another
JRST INTTY1
JRST .-2
IFN CCA,<
INTDB1: PUSHJ P,INTDC1 ;delete a byte
JRST INTTY1
MOVEM B,STRNG1
PUSHJ P,DPYDEL ;erase it
JRST INTDB1
PUSHJ P,BUGSTP
JRST INTDB1
>;IFN CCA
;INTTDC INTDTD INTDTD INTDC1 INTDC2 DPYDEL DPYDL1 DPYDL2
INTTDC: PUSHJ P,INTDC1
JRST INTTY1 ;buffer now empty
PUSH P,A
IFN DELCHJ,<
MOVEM B,STRNG1
XCTMU [IBP STRNG1]
MOVEI A,101
DELCH ;delete char from dpy
JFCL ;not a TTY
JRST INTDTD ;line empty
JRST INTDTD ;deleted and accounted
MOVEI A,"\"
PBOUT
XCTMU [LDB A,STRNG1]
PBOUT
INTDTD:
>;IFN DELCHJ ;note that falls thru on non-dpy
IFE DELCHJ,<
IFN CCA,<
MOVEM B,STRNG1
PUSHJ P,DPYDEL
JRST INTDTD
>;IFN CCA
MOVEI A,"\"
PBOUT
MOVEM B,STRNG1 ;put pointer in memory
XCTMU [ILDB A,STRNG1] ;where ILDB will get it
PBOUT ;note character deleted
IFN CCA,<
INTDTD:
>;IFN CCA
>;IFE DELCHJ
POP P,A
JRST INTTD1 ;character deleted
INTDC1: AOS B,IOCNT ;uncount the character
CAIL B,0(G) ;buffer now empty?
JRST INTDC2 ;yes
IBP IOBPT
IBP IOBPT
IBP IOBPT
IBP IOBPT
SOS B,IOBPT
JRST CPOPJ1
INTDC2: PUSH P,A
MOVEI A,C.BELL ;bell
PBOUT ;ring it
JRST APOPJ
IFN CCA,< ;CCA's display delete code
DPYDEL: PUSH P,A
PUSH P,B
MOVEI A,101
GTTYP ;each time in case detached
CAIE B,4 ;two types of DM's
CAIN B,5
JRST DPYDL1
CAIN B,12 ;or perhaps a random scope?
JRST DPYDL1
AOS -2(P) ;not a display, lose!
JRST DPYDL2
DPYDL1: XCTMU [ILDB B,STRNG1] ;get the byte being deleted
HRROI A,[BYTE (7) "H"-100," ","H"-100]
CAIL B," " ;crock-if control, double it
JRST DPYDL3
PUSH P,A
PSOUT
POP P,A
DPYDL3: PSOUT
DPYDL2: POP P,B
POP P,A
POPJ P,
>;IFN CCA
;INTREP INTRP1 INTRP2 INBYT
INTREP: PUSHJ P,CRLF
PUSH P,IOBPT ;and pointer
SETZ B,
IDPB B,IOBPT ;make ASCIZ string
SKIPA B,IOCNT
INTRP1: AOS B
CAIL B,(G) ;at beginning
JRST INTRP2 ;yes
IBP IOBPT ;no
IBP IOBPT
IBP IOBPT
IBP IOBPT
SOS IOBPT
JRST INTRP1
INTRP2: PUSH P,A
MOVE A,IOBPT
PSOUT
POP P,A
POP P,IOBPT
JRST INTTD1
IFN SAMFRK,<
INBYT: BIN ;get first byte
MOVE G,B ;save it
GTSTS
TLNE B,1000 ;end of file?
JRST INTY8A ;yes
MOVE B,G
SOSGE IOCNT
JRST INDON1
IDPB B,IOBPT
MOVE 2,IOBPT
MOVN 3,IOCNT
SIN ;let monitor do the looping
MOVEM 2,IOBPT
MOVNM 3,IOCNT ;store updated byte count
JRST INTTY9
>;IFN SAMFRK
;INDSK INDSKB
;Routine to input from DSK via PMAP since SIN is slower. And of course we
;must be virtuous, and never sin.
INDSK: SKIPN B,MAPTAB(BB) ;has mapping been vetoed?
JRST INBYT ;yes, use byte routine
RFPTR ;get current position, save it
PUSHJ P,ERROR
PUSH P,B ;stack current pointer
MOVE C,B ;copy it
LSH C,-11 ;make page number
HRLI C,(A) ;put in JFN
CAMN C,MAPTAB(BB) ;same page as currently mapped?
JRST INDSKB ;yes.
MOVEM C,MAPTAB(BB) ;no, mark that's what we will get now
MOVE A,C ;set as arg to rpacs
RPACS ;see if page exists.
TLNN B,(1B5) ; ..
SETOB A,MAPTAB(BB) ;no, put empty page in map, will get 0's
; if referenced, due to holey file
MOVEI B,IOMPGS(AC) ;yes, convert I/O channel number to
HRLI B,.S ; page handle for mapping
MOVSI C,(1B2) ;request read access
PMAP ;get the page
INDSKB: PUSHJ P,PTRGET ;get address of EOF
PUSHJ P,ERROR ;can't fail
POP P,C ;get current position
SUB B,C ;compute distance to end
JUMPLE B,INTY8A ;jump if beyond end
SUBI B,200 ;no, update distance for this buffer
SKIPL B ;skip if EOF in this buffer
SETZ B, ;no, full buffer
MOVNM B,IOCNT ;save for setibf
MOVEI B,200 ; no, update it for this buffer
ADD B,C ; ..
SFPTR ; ..
PUSHJ P,ERROR ;can't fail ..
MOVEI B,IOMPGS(AC) ;get page number from I/O channel number
LSH B,11 ;make an address
ANDI C,777 ;word within page
ADDI C,(B) ;plus page in this fork
MOVSI A,(C) ;makes BLT "from" address
HRR A,IOBPT ;to address -1
ADDI A,1 ;to address
MOVEI B,177(A) ;last address
BLT A,(B) ;move the data
MOVEI A,200 ;update one more buffer read.
SUB A,IOCNT ;minus portion not read if any
ADDM A,IOBPT ; ..
MOVSI A,400000 ;set buffer use bit
XCTUU [IORM A,@(CC)]
POPJ P,
;OUTMTA INMTA MTALP2 MTALP MTALP1 DMP2 DMP3 EOFCHK DMPOER
OUTMTA: TROA PF,R.DIRN ;flag output direction
INMTA: TRZ PF,R.DIRN ;flag input direction
SKIPG B,IOCNT
POPJ P,
SETZM ERRCNT ;clear retry count
MOVE C,IOBPT ;pointer into buffer
ADDM B,IOBPT ;update pointer
MOVN B,B ;IOWD for transfer
HRLI C,(B)
MOVEM C,DMPLST ;put it in command list
SETZM DMPLST+1 ;with terminator
MOVEI B,DMPLST ;where list starts
SETZM MTDUMP ;clear recovery cell
MTALP2: MOVEM B,SPDELC ;initial command
MTALP: MOVE B,SPDELC ;next or corrected I/O list
TRNE PF,R.DIRN ;output?
JRST DMP2 ;yes, go do output
DUMPI
JRST EOFCHK
JRST DMP3
MTALP1: SETZM ERRCNT ;no errors, enter here from dump I/O
SETOM MTDUMP ;flag dump mode request
JRST MTALP2 ;go to it
DMP2:
IFN MTWEOF,< ;IFN IMSSS keeps track of write status
PUSH P,A
PUSH P,B
SETZ A, ;assume unit 0
MOVE B,DEVNAM(BB) ;get device name
CAME B,[SIXBIT /MTA0/]
MOVEI A,1 ;must be unit 1
SETOM MTAWR(A) ;set write flag
POP P,B
POP P,A
>;IFN MTWEOF
DUMPO
JRST DMPOER
DMP3: SETZM IOCNT ;ok
JRST RECCH1 ;update the status
EOFCHK: CAIE A,IOX4 ;EOF?
JRST RECCHK ;no
MOVEI A,1B22
IORM A,FLAGWD(BB)
JRST DMP3
DMPOER: PUSHJ P,TAPERR ;retry
JRST MTAERR ;tried too many times.
JRST MTALP ;try again
;RECCHK RECCH2 MTAERR RECCH1 TAPERR RETRY
;Input error other than EOF from DUMPI
RECCHK: MOVE A,JFNTAB(BB) ;get the JFN
GDSTS ;get the Tenex status
TRNE B,722000 ;errors?
JRST [ PUSHJ P,TAPERR ;yes, too many?
JRST MTAERR ;yes.
JRST MTALP] ;no, try again.
TRNN B,10000 ;record length error?
PUSHJ P,ERROR ;some other I/O error I don't know about
SKIPG ERRCNT ;retried this one yet?
PUSHJ P,TAPERR ;no. try it over once
JRST RECCH2 ;too many, it's for real (maybe ok, tho.)
JRST MTALP ;try it over once.
RECCH2: HLRZ C,C ;word count
SUB C,IOCNT ;words not transferred
MOVNM C,IOCNT
MTAERR: PUSHJ P,GST2 ;convert to 10/50 error bits
SKIPG IOCNT ;was error really too long?
TRO A,1B21 ;yes, too short isn't an error on 10/50
HRRM A,FLAGWD(BB) ;store status bits.
MOVE A,JFNTAB(BB)
SETZ B,
MTOPR ;clr error flags
POPJ P,
;Here on success for DUMPI or DUMPO, no errors. Just update
; the physical unit status bits
RECCH1: PUSHJ P,GST2 ;update flags
HRRM A,FLAGWD(BB) ;in channel control block
POPJ P, ;and return to dump I/O processor
TAPERR: AOS A,ERRCNT
CAIL A,MAXERR ;tried enough?
POPJ P, ;yes
RETRY: MOVE A,JFNTAB(BB)
MOVEI B,7
MTOPR ;backspace one record
REPEAT 0,< ;this doesn't work because
;won't be at BOT after backspace,
; due to 3 inches blank off BOT.
GDSTS
TRNE B,4000 ;beginning of tape?
JRST CPOPJ1 ;yes, try again
MOVEI B,7 ;no
MTOPR ;back one more
MOVEI B,6
MTOPR ;and forward one
>;REPEAT 0
JRST CPOPJ1 ;go try again
;OUTT OUTTN OUTT1 OUTT2 OUTT9
OUTT: PUSHJ P,SETUP
MOVE B,FLAGWD(BB)
TLNE B,OOPENF ;open for output?
JRST OUTTN ;yes
SKIPN JFNTAB(BB) ;does it have JFN?
TLNN B,OUFIRF ;or is it first time through?
TLNN B,INITF ;and is it init'ed?
PUSHJ P,ERRCHN ;no- error
SKIPN JFNTAB(BB) ;does it have JFN?
JRST OUTTN ;no, don't open it yet
MOVEI B,1B20
PUSHJ P,OPENX ;open for output
MOVSI A,OOPENF
IORM A,FLAGWD(BB) ;and mark it
OUTTN: MOVEI A,17
AND A,FLAGWD(BB) ;mode
CAIL A,15 ;is it a buffered mode?
JRST OUTDMP ;no
HLRZ CC,BUFHTB(BB) ;output buffer header pointer
HRRZ A,FORTY
CAIE A,0 ;new ring?
MOVEM A,0(CC) ;yes, store address
MOVSI A,OUFIRF ;first time through flag
TDNE A,FLAGWD(BB) ;is it?
JRST OUTT2 ;no
IORM A,FLAGWD(BB) ;yes
OUTT1: MOVEI C,2
MOVSI B,OUTBFF ;OUTBUF done flag
XCTUU [SKIPN 0(CC)] ;output buffers setup?
PUSHJ P,IOBUF ;not yet
XCTUU [SKIPGE A,(CC)] ;clear ring use bit by stepping
JRST OUTT9 ;buffer to itself, and clear buffer too
OUTT2: PUSHJ P,SETOBF
MOVE A,JFNTAB(BB) ;get destination
PUSHJ P,@OUTLST(AA)
MOVE B,(CC) ;current buffer address
HRRZ A,FLAGWD(BB) ;file status
MOVEM A,-1(B) ;store latter in beginning of former
XCTUU [MOVE A,@(CC)] ;advance the buffer
OUTT9: XCTUU [HRRZM A,(CC)]
JRST INIBUF
;OUTLST OUTDMP OUTDM1 OUTDM3
OUTLST: EXP OUTBYT ;DSK
EXP ITRAP ;DRM
EXP OUTMTA ;MTA
EXP OUTBYT ;DTA
EXP ITRAP ;PTR
EXP OUTBYT ;PTP
EXP ITRAP ;PTR
EXP OUTASC ;LPT
EXP ITRAP,ITRAP,OUTTTY ;CDR,CDP,TTY
EXP OUTTTY,ITRAP ;TTP,TTR
EXP OUTBYT ;NIL
EXP OUTBYT ;NET
EXP OUTBYT ;PLT
OUTDMP: MOVE A,JFNTAB(BB) ;JFN
CAIN AA,0 ;disk device type?
JRST OUTDM2 ;yes, simulate DUMPO by SOUT
HRRZ B,FORTY ;no, use DUMPO
CAIGE B,20 ;pointer in AC's?
ADDI B,ACS ;yes, point to stored AC's
TRO PF,R.DIRN ;direction is output.
MOVE C,DEVTBL(AA)
TLNE C,MTADEV ;mag tape?
JRST MTALP1 ;yes, go to mag tape handler
OUTDM1: DUMPO
JRST OUDMER ;lost, see if recoverable
OUTDM3: POPJ P,
;OUDMER OUDME1 OUDME2 OUDME3 OUTDM2 OUTCML OUTDM4 OUDM4L
OUDMER: PUSHJ P,DTAX3Q ;see if DTA size error.
PUSH P,B ;yes, save position of IOWD
PUSH P,0(B) ;stash offending IOWD
OUDME1: MOVSI A,MAXIOL ;a reasonable Tenex length
ADD A,0(P) ;within that far of end?
JUMPG A,OUDME2 ;jump if so.
MOVSI A,-MAXIOL ;make a partial IOWD
HRR A,0(P) ; ..
MOVEM A,DMPLST ;stash it for DUMPO
SETZM DMPLST+1 ;and clear for a terminator
MOVE A,JFNTAB(BB) ;get the JFN
MOVEI B,DMPLST ;and where the short I/O list is
DUMPO ;try it again, Sam
PUSHJ P,ERROR ;if this loses, give up.
MOVE A,[XWD MAXIOL,MAXIOL] ;update the pointer
ADDM A,0(P) ; ..
JRST OUDME1 ;and try the rest of it
OUDME2: POP P,DMPLST ;get back the partial I/O list left
MOVE A,JFNTAB(BB) ;get the JFN back
HLLZ B,DMPLST ;did I/O list just now run out?
JUMPE B,OUDME3 ;if so, skip I/O
MOVEI B,DMPLST ;point to I/O list
DUMPO ;try to output remaining stuff
PUSHJ P,ERROR ;can't
OUDME3: POP P,B ;get the position in original I/O list
ADDI B,1 ;point after troublesome guy
SKIPE 0(B) ;more to do yet?
JRST OUTDM1 ;yes, go try next IOWD
JRST OUTDM3 ;no, quit.
OUTDM2: HRRZ D,FORTY ;command list pointer
OUTCML: CAIGE D,20 ;in the ACs?
ADDI D,ACS ;yes, point to stored ACs
MOVE C,(D) ;command loop
JUMPE C,OUTDM3 ;done on zero command
TLNE C,-1 ;zero left half means GO TO
JRST OUTDM4 ;no, real I/O word
MOVE D,C
JRST OUTCML
OUTDM4: HRRI B,1(C) ;first location
HRLI B,444400 ;binary transfer
HLRO C,C ;word count
PUSH P,C ;save number of words
SOUT
POP P,C ;get number of words sent
OUDM4L: TRNN C,177 ;was it a multiple of 200 octal?
AOJA D,OUTCML ;yes, go get next command
MOVEI B,0 ;no. send a zero
BOUT ; ..
SOJA C,OUDM4L ;and see if full blk
;OUTTTY OUTTTL OUTTTB OUTTBL OUTTTX OUTASC OUTBYT
;ASCII output routines
OUTTTY: LDB B,[POINT 4,FLAGWD(BB),35] ;I/O mode
CAIL B,10 ;binary?
JRST OUTTTB ;yes.
OUTTTL: SOSGE IOCNT ;count down the bytes
POPJ P, ;no more in buffer
XCTMU [ILDB B,IOBPT] ;get another byte from user buffer
SKIPE B ;but don't output nulls
PUSHJ P,TTYBOU ;output the byte, check ↑O, indicate.
JRST OUTTTL ;loop for more from buffer
OUTTTB: RFMOD ;get file mode
PUSH P,B ;save it
TRZ B,3B29 ;set to binary for output
SFMOD ; ..
OUTTBL: SOSGE IOCNT ;count of bytes
JRST OUTTTX ;done
XCTMU [ILDB B,IOBPT] ;get a byte
PUSHJ P,TTYBO1 ;do the BOUT at common PC
JRST OUTTBL ;loop thru buffer
OUTTTX: POP P,B ;get back old tty mode
SFMOD
POPJ P,
OUTASC: SOSGE IOCNT ;count bytes
POPJ P, ;no more in buffer
XCTMU [ILDB B,IOBPT] ;fetch byte from buffer, ptr in header
JUMPE B,OUTASC ;ignore nulls
BOUT ;output to file.
JRST OUTASC
IFN SAMFRK,<
OUTBYT: MOVE 2,IOBPT
MOVN 3,IOCNT
JUMPGE 3,CPOPJ ;it's possible there's nothing to do
SOUT
MOVEM 2,IOBPT
SETZM IOCNT
POPJ P,
>;IFN SAMFRK
;SETOBF SETOB2 SETOB3
;Prepare full buffer for emptying
SETOBF: MOVEI B,17
AND B,FLAGWD(BB) ;mode
XCTUU [HLLZ C,1(CC)] ;get byte size bits
XCTUU [HRRZ D,1(CC)] ;fetch RH of byte pointer
UMOVE E,(CC)
SUBI D,1(E) ;ptr to zero'th word of data
JUMPN AA,.+3 ;disk?
SKIPE FORTY ;yes, and doing out (not CLOSE or RELEASE)?
HRRZ D,DEVTB2(AA) ;yes, 10/50 always copies 200 wds.
MOVEI A,1B31
TDNE A,FLAGWD(BB) ;user wants to specify own count?
JRST SETOB1 ;go get user's count
MOVEI F,0(D) ;save un-multiplied count
LDB A,[POINT 6,C,11] ;byte size
PUSH P,B ;save B over divide
PUSH P,A ;push size
MOVEI A,44 ;word length
SKIPE 0(P) ;in case clobbered
IDIV A,0(P) ;bytes per word
POP P,B ;discard byte size
POP P,B ;restore B
IMULI D,0(A) ;byte count in those words
SETOB2: JUMPLE D,SETOB3 ;perhaps nothing to do
MOVEI C,1(E) ;construct byte pointer for xfer
MOVSI E,HASDIR+MTADEV ;usual check for word transfers
HRLI C,0700 ;transfer 7-bit unless
CAIGE B,10 ;mode is binary, or
TDNE E,DEVTBL(AA) ;device has directory or is magtape
HRLI C,4400 ;in which case transfer 36-bit
MOVEM C,IOBPT
TLNE C,4000 ;if 36-bit xfer,
MOVE D,F ;use un-multiplied count
SETOB3: MOVEM D,IOCNT ;leave count for xfer routine
POPJ P,
;SETOB1
SETOB1: UMOVE D,1(E) ;count
MOVEI F,0(D)
TLNE C,4000 ;binary?
JRST SETOB2 ;yes
LDB A,[POINT 6,C,11] ;need to convert, get byte size.
PUSH P,B ;save B over divide
PUSH P,A ;byte size
MOVEI A,44 ;word length
SKIPE 0(P) ;in case of junk
IDIV A,0(P) ;bytes per word
POP P,B ;discard byte size
POP P,B ;restore B
IDIVI F,0(A) ;convert bytes to words
SKIPE G
AOS D,F ;and fractions thereof
JRST SETOB2
;INIBUF
;Prepare empty buffer
INIBUF: XCTUU [SETZM 1(A)] ;zero the buffer
MOVSI B,1(A)
HRRI B,2(A)
HLRZ C,(A) ;size of data area+1.
ANDI C,377777 ;clear ring use bit
CAIN AA,0 ;if it's a disk
MOVEI C,201 ;force correct size buffer
CAILE C,1 ;should be nonzero buffer size
CAILE C,2000 ;but not too big
PUSHJ P,ERRARG
SUBI C,1
PUSH P,C ;save for later use
ADDI C,1(A)
XCTUU [BLT B,(C)]
MOVEI D,17
AND D,FLAGWD(BB) ;mode
XCTUU [HLLZ B,1(CC)] ;get size bits
TLZ B,770077
HRRI B,1(A)
UMOVEM B,1(CC) ;initialize byte pointer
LDB C,[POINT 6,B,11] ;byte size
MOVEI A,44 ;word size
PUSH P,B ;save B over divide
SKIPE C ;in case of junk in header
IDIVI A,(C) ;bytes per word
POP P,B ;restore B
IMUL A,0(P) ;bytes in buffer
UMOVEM A,2(CC) ;init byte count
MOVSI E,HASDIR+MTADEV ;see if 36-bit xfer possible
HRLI B,0700 ;7-bit unless...
CAIGE D,10 ;binary mode, or
TDNE E,DEVTBL(AA) ;directory device or magtape
HRLI B,4400 ;in which case 36-bit
MOVEM B,IOBPT
POP P,A ;buffer length
TLNN B,4000 ;small bytes?
IMULI A,5 ;yes, 5 per word
MOVEM A,IOCNT
POPJ P,
;URELEA URELR UREL2 IRESET REL0
URELEA: PUSHJ P,SETUPG
JRST MRETN ;nothing to release
PUSHJ P,URELR ;do the release
JRST MRETN
URELR: SKIPN DEVNAM(BB)
POPJ P,
LDB AA,PDVNUM ;get device type code
SETZM IOCNT
PUSHJ P,UCL1K ;close file, keeping JFN
MOVE A,JFNTAB(BB)
CAIE A,PRIJFN ;real JFN?
CAIN A,PROJFN ; ..
JRST UREL2 ;no
MOVE A,JFNTAB(BB) ;get JFN back
JUMPE A,UREL2
RLJFN
PUSHJ P,ERROR
UREL2: HLLZS FLAGWD(BB) ;clear init bits.
MOVS A,DEVNAM(BB) ;get swapped device name
CAIN A,'TTY' ;controlling TTY?
PUSHJ P,TTYSTS ;yes, set up for normal init bits
SETZM CHTABS(BB)
MOVSI A,CHTABS(BB)
HRRI A,CHTABS+1(BB)
BLT A,CHTABS+NTABS-1(BB)
POPJ P,
IRESET: SETZM USRENB ;clear user-requested interrupts
PUSHJ P,SETPSI ;and adjust PSI system accordingly
PUSHJ P,NOCTRO ;clear control-O flag
MOVEI BB,NTABS ;channel 1
PUSHJ P,URELR ;release it
ADDI BB,NTABS
CAIE BB,20*NTABS
JRST .-3 ;next channel
REL0: MOVEI BB,0 ;channel 0
JRST URELR ;release it
;RUN GETSEG RUN11B RUN11 RUN11A
SUBTTL Environment stuff. SAVGET.
RUN: PUSHJ P,IRESET ;release all the channels
TROA PF,R.RUNU ;denote GETSEG, not RUN
GETSEG: TRZ PF,R.RUNU ;denote RUN, not GETSEG
PUSHJ P,REL0 ;release channel 0
IFN LINKP,<
SKIPN LINKS ; have we looked for links file before?
PUSHJ P,GETLNK ; no, then try now (only done once)
>;IFN LINKP
HLRZM CAC,MTDUMP ;stash the CCL offset
UMOVE A,@PDL ;get return instruction
LSH A,-30 ;see if it's a halt
CAIN A,2542 ; ..
TRO PF,R.RHLT ;yes, remember that.
MOVEI AA,1(CAC) ;pointer to name in arg list
UMOVE D,(AA)
HRROI E,FILNM7
MOVEM E,JBLOCK+4
PUSHJ P,SIXTO7
UMOVE D,-1(AA) ;device name
HRROI E,DEVNM7
MOVEM E,JBLOCK+2
MOVEI B,NSPDDV-1 ;number of special disk devices
CAMN D,SPDDVT(B) ;check for match
JRST RUN11B ;handle special device
SOJGE B,.-2 ;loop if more to look at
JRST RUN11 ;handle std device
RUN11B: CAMN D,SPDSYS ;check specifically for SYS:
TRO F,R.SYS ;set on bit for it (system names)
HRRO D,SPDDVN(B) ;get ASCII name pointer
MOVEM D,JBLOCK+3 ;save for GTJFN
MOVE D,[ASCIZ /DSK/] ;device string
MOVEM D,DEVNM7 ;save it
JRST RUN12 ;and skip
RUN11: PUSHJ P,SIXTO7 ;put in device name from user
UMOVE B,3(AA) ;PPN from user
PUSHJ P,CHKDIR ;handle sixbit directory names
JUMPLE B,RUN11A ;self if .LE. 0
TLZ B,1 ;allow project 0 or 1
HRROI A,DIRNAM ;store directory name
MOVEM A,JBLOCK+3 ;arg to GTJFN
DIRST ;user exist?
RUN11A: SETZM JBLOCK+3 ;no, try in own directory
; JRST RUN12
;RUN12 RUN12A RUN12B RUN19 GETFAL RUN13
RUN12: HRROI E,EXT7 ;point to extension storage
MOVEM E,JBLOCK+5 ;for GTJFN, though don't know ext yet
MOVSI A,100000
MOVEM A,JBLOCK
MOVE A,[XWD 377777,377777]
MOVEM A,JBLOCK+1
TRZ PF,R.FAIL ;flag first time thru LOOKUP process
IFN LINKP,<
HRROI A,-<NLINKS+1> ;start at the top
MOVEM A,LNKRUN ;start at first link
>;IFN LINKP
RUN12A: XCTUU [HLLZ D,1(AA)] ;get extension
JUMPE D,RUN19 ;none there- try defaults
TRNN PF,R.RUNU ;GETSEG?
JRST RUN19 ;yes, ignore supplied ext.
PUSHJ P,RUN15 ;use given ext
JRST RUN13 ;success, found it
TRON PF,R.FAIL ;failed, first pass?
SKIPN JBLOCK+3 ;trying connected directory?
IFE LINKP,<
JRST MRETN
>;IFE LINKP
IFN LINKP,<
JRST RUN12B ;no, try it then
>;IFN LINKP
SETZM JBLOCK+3 ;try own directory
JRST RUN12A ;loop back around.
IFN LINKP,<
RUN12B: AOSL A,LNKRUN ;get next link
JRST MRETN ;no such file if run off links
SKIPN A,LNKBP+NLINKS(A) ;a directory to use?
JRST RUN12B ;no, flush it
MOVEM A,JBLOCK+3 ;try using this directory
JRST RUN12A
>;IFN LINKP
;Here for default extension(s)
RUN19: PUSHJ P,RUN08 ;try to get extension .SHR
JRST RUN13 ;success
PUSHJ P,RUN09 ;no good- try for .HGH
JRST RUN13 ;success
PUSHJ P,RUN10 ;try for .SAV
JRST [ TRNE PF,R.RUNU ;found .SAV - GETSEG or RUN?
JRST RUN18 ;RUN, load whole thing.
JRST RUN13] ;GETSEG, just high part.
GETFAL: TRZ F,R.SYS ;now not from SYS
TROE PF,R.FAIL ;skip if haven't tried own dir yet.
IFE LINKP,<
JRST RETZER
>;IFE LINKP
IFN LINKP,<
JRST [ AOSL A,LNKRUN
JRST RETZER ;RUN loses if no .SAV either
SKIPN A,LNKBP+NLINKS(A)
JRST .
MOVEM A,JBLOCK+3
JRST RUN19] ;try next directory in link
>;IFN LINKP
SETZM JBLOCK+3 ;own directory is default
JRST RUN19 ;try again
;Here after GTJFN succeeds
RUN13: MOVEM A,JFNTAB
TRNE PF,R.RUNU ;RUN UUO? (not GETSEG)
JRST RUN23 ;yes
PUSHJ P,DOGTSG ;do the page transfers
JRST RETZER ;weren't any in high segment
JRST RUN24 ;ok, go finish up
;RUN23 RUN24 RUN21 RUN18
RUN23: UMOVE B,0(AA) ;get sixbit program name
PUSH P,B ;save it
PUSH P,.JBERR ;and error count
HRLI A,400000 ;current fork, this JFN
GET
MOVEI A,400000 ;this fork
GEVEC ;get entry vector
XCTUU [HRRM B,.JBSA] ;store starting address
POP P,.JBERR ;restore error count
POP P,A ;name of program
TRNE F,R.SYS ;from <SUBSYS> directory?
SETNM ;yes, update system tables
RUN24: MOVE A,JFNTAB
RLJFN ;try to release JFN
JFCL ;won't release if SSAVE file
TRNE PF,R.RUNU ;was this a RUN UUO?
JRST RUN21 ;yes
UMOVE B,400003 ;GETSEG only changes .JBHRL
HLRZS B ;set to top of that K of core
TRNE B,-1 ;unless there isn't one
TRO B,401777 ;high seg, one K.
UMOVEM B,.JBHRL
MOVEM B,JBHRL
JRST RUN14
RUN21: PUSHJ P,SETVES
XCTUU [HLRZ A,.JBCOR]
CAIGE A,.JBDA ;should there be a low seg too?
JRST RUN14 ;no
MOVSI D,(SIXBIT/LOW/) ;yes, get it
HRROI E,EXT7
PUSHJ P,SIXTO7
MOVEI A,JBLOCK
SETZ B,
GTJFN
JRST RUN20 ;no good, can't find it
RUN18: MOVEM A,JFNTAB
UMOVE B,0(AA) ;get sixbit program name
PUSH P,B ;save it
PUSH P,.JBERR ;and error count
HRLI A,400000
GET
MOVE A,JFNTAB
RLJFN ;try to release JFN
JFCL ;won't release if SSAVE file
POP P,.JBERR ;restore error count
POP P,A ;and program name
TRNE F,R.SYS ;a system program?
SETNM ;yes, tell monitor
HRRZ A,JBREL ;get current low seg
UMOVE B,.JBREL ;and new one
PUSHJ P,SHRINK ;reduce segment if needed
HRRZ A,JBHRL ;also current high seg
UMOVE B,.JBHRL ;and new one
MOVEM B,JBHRL ;update PAT's copy.
HRRZS B ;right half only
CAIL A,.S ;if there is a current one,
PUSHJ P,SHRINK ;reduce it as needed
UMOVE A,.JBREL
MOVEM A,JBREL
; JRST RUN14
;RUN14 RUN08 RUN09 RUN10 RUN15 RUN20
RUN14: SETZ BB,
PUSHJ P,UREL2 ;release channel 0
TRNN PF,R.RUNU ;was it a RUN UUO?
JRST MRETN2 ;return skipping from GETSEG
UMOVE A,.JBSA ;RUN goes off to prog start adr
ADD A,MTDUMP ;plus user's CCL offset
UMOVEM A,.JBSA ;update .JBSA by offset
;;;if offset over 1, meddling... (FOO!!!)
HRRM A,(P)
JRST MRETN
RUN08: MOVSI D,(SIXBIT/SHR/)
JRST RUN15
RUN09: SKIPA D,[SIXBIT/HGH/]
RUN10: MOVSI D,(SIXBIT/SAV/)
RUN15: HRROI E,EXT7
PUSHJ P,SIXTO7
MOVEI A,JBLOCK
SETZ B,
GTJFN
AOS (P) ;failed
POPJ P, ;successfully got JFN
RUN20: SETZ BB,
PUSHJ P,UREL2 ;release channel 0
JRST MRETN ;take error exit
;SHRINK
;Shrink a segment. A/ old words top, B/ new words top.
SHRINK: JUMPE A,CPOPJ ;in case old value missing
CAIG A,(B) ;old really bigger?
POPJ P, ;no. return.
PUSH P,A ;be transparent
PUSH P,B
PUSH P,D
CAIL A,400000 ;old in hiseg?
CAIL B,377777 ;yes, new in low seg?
CAIA ;no, both in same seg.
MOVEI B,377777 ;yes, don't shrink high into low.
MOVEI D,(A) ;copy old size
LSH D,-11 ;convert to page numbers
LSH B,-11
SETO A, ;remap from null-space
TLOA B,400000 ;this fork, skip.
PMAP ;page to remove
CAILE D,(B) ;removed all intervening?
AOJA B,.-2 ;not, remove one more
POP P,D ;restore ACs.
JRST BAPOPJ ;and return.
;DOGTSG DOGSL1 DOGS1A DOGS1B DOGSN1
;Subroutine to get high segment pages into fork
;Skips if there are any pages in high seg
DOGTSG: TRZ PF,R.PAGX ;no high pages seen yet.
MOVSI A,(1B1) ;flag want a new fork
CFORK ;get one
PUSHJ P,ERROR ;should be able to.
MOVE F,A ;hold fork number
HRLZ A,F ;fork to get into
HRR A,JFNTAB ;JFN of channel zero
GET ;get the file
MOVEI G,400 ;page of high seg
DOGSL1: MOVSI A,0(F) ;fork gotten into
HRR A,G ;page number
RPACS ;page exist?
TLNN B,(1B5) ; ..
JRST [ SETO A, ;no, remove corresponding page in this
JRST DOGS1B] ; fork's space
TRO PF,R.PAGX ;yes, at least one page exists
TLNN B,(1B10) ;private memory?
JRST DOGS1A ;no, can copy via RMAP.
MOVE B,[XWD .S,PATSPG] ;yes, put it into scratch page
MOVSI C,(1B2) ;make indirect pointer for read
PMAP ; ..
MOVEI C,(G) ;page it's going to.
HRLI C,PATSPG ;from scratch page
LSH C,11 ;words, not pages.
MOVEI B,777(C) ;to end of page
BLT C,0(B) ;move it.
JRST DOGSN1 ;on to next page.
DOGS1A: RMAP ;get handle on page
DOGS1B: MOVE B,G ;page in this fork
HRLI B,.S ;this fork handle
MOVSI C,120400 ;access is R,X,CW
PMAP ;get the page
DOGSN1: CAIGE G,PATPAG-1 ;through all pages up to PAT?
AOJA G,DOGSL1 ;no, get another one.
HRRZ A,F ;inferior fork name
KFORK ;kill it off.
TRNE PF,R.PAGX ;were there any pages?
AOS (P) ;yes, skip return.
POPJ P, ;return from do GETSEG routine
;SETVES SETVS1 VESTIG NVSTIG MAKVES MAKVS2 MAKVS1 VESTG2
;Copy vestigal job data area from hiseg to loseg
SETVES: MOVSI B,-NVSTIG
UMOVE C,400000(B)
XCT VESTIG(B)
SETVS1: AOBJN B,.-2
UMOVE B,.JBHRL
MOVEM B,JBHRL
POPJ P,
VESTIG: UMOVEM C,.JBSA
UMOVEM C,41
UMOVEM C,.JBCOR
JRST [ XCTUU [HRRZM C,.JBREN]
HLRS C ;rel top of high seg
TRNE C,-1 ;if there is any
TRO C,401777 ;top of the K in high seg
UMOVEM C,.JBHRL ;store it in low job data area
JRST SETVS1]
UMOVEM C,.JBVER
NVSTIG==.-VESTIG
;Copy vestigal job data area from loseg to hiseg
MAKVES: MOVSI B,-NVSTIG
XCT VESTG2(B)
MAKVS2: UMOVEM C,400000(B)
MAKVS1: AOBJN B,.-2
POPJ P,
VESTG2: UMOVE C,.JBSA
UMOVE C,41
UMOVE C,.JBCOR
JRST [XCTUU [HLL C,.JBHRL]
XCTUU [HRR C,.JBREN]
JRST MAKVS2 ]
UMOVE C,.JBVER
;URESET RS3 RS3A RS2
;CALLI 0 reset handler
URESET: MOVSI 2,-20 ;-20,,0
RS3: MOVE 1,JFNTAB(2) ;get JFN for channel 0
JUMPE 1,RS2 ;does it have one?
CAIE A,PRIJFN
CAIN A,PROJFN ;don't close primary I/O
JRST RS2 ; ..
;We should also unmap any file pages that are mapped, since the
;CLOSF won't otherwise.
SKIPG MAPTAB(2) ;page mapped?
JRST RS3A ;no
PUSH P,2 ;save counter word
HRRZS 2 ;isolate multiple of ntabs
IDIVI 2,NTABS ;form table number
MOVEI 2,IOMPGS(2) ;get addr of page
HRLI 2,.S ;this fork
SETO 1,
PMAP ;out of process map
POP P,2 ;restore our counter
MOVE 1,JFNTAB(2) ;and the JFN
RS3A: CLOSF ;yes
MOVE 1,JFNTAB(2)
RLJFN
JFCL
RS2: ADDI 2,NTABS-1
AOBJN 2,RS3 ;now do it for channels 1-17
MOVE 1,[XWD CHTABS,CHTABS+1]
SETZM -1(1)
BLT 1,CHTEND-1 ;clear file data area
XCTUU [HLRZ A,.JBSA]
XCTUU [HRRM A,.JBFF]
PUSHJ P,TTBFIN ;clear TTCALL input buffer
PUSHJ P,SETPSI ;set up the PSI system
JRST MRETN
;CORE COREUU COREU2 CCLEAR CCLRLP
CORE: SKIPE CAC ;0 arg gives free core, error return
PUSHJ P,COREUU
CAIA
AOS (P) ;ok return, R2
MOVEI A,PATLOC ;return how much he can have
LSH A,-↑D10 ;in K
JRST STOTAC ;return it in the AC
COREUU: TLNN CAC,-1 ;any change to high segment?
JRST COREU4 ;no
HLRZ B,CAC
TRO B,1777
HRRZ C,JBHRL
CAIN C,0 ;none?
MOVEI C,377777 ;yes, pretend word before possible top
HRRZ D,JBREL
CAIG D,400000 ;max of .JBREL, 400000
MOVEI D,400000
CAIG B,(D) ;negative hiseg length?
JRST FLUSHI ;yes
CAIG B,(C) ;more than before?
JRST COREU2 ;no
PUSHJ P,CCLEAR ;clear map for new core
JRST COREU3
COREU2: HRRZ D,JBREL
ADDI D,(B)
CAILE D,-1 ;do the two overlap?
POPJ P, ;yes, R1
MOVEI A,(C) ;get old word size
PUSHJ P,SHRINK ;remove pages if needed.
JRST COREU3 ;on to check low seg.
CCLEAR: CAIGE B,2(C) ;really growing?
POPJ P, ;no, same as old.
PUSH P,B
PUSH P,C ;save args
LSH C,-11 ;page number of old high
LSH B,-11 ;page number of new high
MOVNI D,1(B) ;compute distance
ADDI D,1(C) ; ..
HRLZS D ;neg count in LH
HRRI D,1(C) ;first to throw away
CCLRLP: SETO A, ;arg for remove page from map
MOVE B,D ;page number in RH
HRLI B,400000 ;this fork
PMAP ;make sure slot empty
AOBJN D,CCLRLP ;all pages in new core area
POP P,C
POP P,B
POPJ P,
;FLUSHI COREU3 COREU4 CORU10 COREU6 COREU7 COREU9
FLUSHI: HRRZ A,JBHRL ;old high seg size
MOVEI B,.S-1 ;new size is zero.
PUSHJ P,SHRINK ;shrink the high segment
SETZ B,
COREU3: MOVEM B,JBHRL
XCTUU [HRRM B,.JBHRL]
COREU4: TRNN CAC,-1 ;any change to low seg?
JRST CPOPJ1 ;no
CORU10: HRRZ B,CAC
TRO B,1777
HRRZ C,JBREL
CAIL B,PATLOC ;arg ok?
POPJ P,
MOVEM B,JBREL
XCTUU [HRRM B,.JBREL] ;new .JBREL
HRRZ B,JBREL ;new .JBREL
CAIG B,(C) ;more than before?
JRST COREU7 ;no
PUSHJ P,CCLEAR ;clear map for new low seg area
COREU6: JRST COREU9
COREU7: MOVEI A,0(C) ;new low seg
PUSHJ P,SHRINK ;adjust segment size
COREU9: JRST CPOPJ1
XLIST ;don't list LIT statement which is big
LIT ;reduce working set if lucky
LIST ;LIT is to reduce working set if lucky
;ONCE ONCE1
SUBTTL ONCE and other rare routines
;First time initialization
ONCE: MOVE A,20 ;reference page 0 to create it if needed
MOVE A,1777 ;and page 1 ( a whole K)
MOVE A,[XWD TSLOC,TSLOC+1]
SETZM -1(A)
BLT A,CLRTOP
MOVSI PF,L.DBUG ;clear all flags but this one
ANDM PF,PFLAGS ; ..
MOVSI PF,L.ONCE ;and set this one, been thru once code
IORB PF,PFLAGS ;and load flags into AC
GJINF ;get these only once
MOVEM C,MYJOBN
HRLI B,1 ;pretend I am in project 1
MOVEM B,MYPPN ;1,,logged-in dir as PPN
UMOVE A,.JBREL
JUMPN A,ONCE1 ;setup?
MOVE A,[XWD 400000,400] ;no, is there a readable page 400?
RPACS
TLNE B,(1B2)
PUSHJ P,SETVES ;yes, setup job data area from vestig
MOVEI C,PATPAG-1 ;scan map to find highest used page
XCTUU [SKIPE .JBHRL] ;high seg?
MOVEI C,377 ;yes, scan down from hiseg
MOVSI A,400000
HRRI A,(C)
RPACS
TLNN B,(1B2) ;is page readable?
SOJG C,.-3 ;no
MOVEI A,(C) ;this is highest page
LSH A,↑D9
HRRZ B,.JBCOR ;highest load address
CAIGE A,(B) ;max of that and highest page
MOVEI A,(B)
ONCE1: TRO A,1777 ;1K pages
UMOVEM A,.JBREL
MOVEM A,JBREL
UMOVE A,.JBS41 ;saved contents of 41
XCTUU [SKIPN 41] ;41 needs setup?
UMOVEM A,41 ;yes
;falls through
;NOSTAT
;drops in
UMOVE A,.JBHRL
CAIE A,0 ;don't change if no hiseg
TRO A,1777 ;1k page
UMOVEM A,.JBHRL
MOVEM A,JBHRL
PUSHJ P,SETPSI ;set up pseudo interrupt system
MOVEI A,101 ;controlling terminal
RFCOC ;see what echoing of controls is set at
TRNN B,4000 ;has user requested ↑L be indicated?
TLO PF,L.INDF ;yes, carry that datum around in flags
IFN FTSTAT,<
MOVSI A,100001 ;get the statistics file
IFE CCA,<
HRROI B,[ASCIZ /<SYSTEM>PA1050.STATISTICS;1/]
>;IFE CCA
IFN CCA,<
HRROI B,[ASCIZ /<SYS-LOG-MSG>PA1050.STATISTICS;1/]
>;IFN CCA
GTJFN
JRST NOSTAT ;hasn't been made on SYS
PUSH P,A ;save JFN
MOVEI B,302000 ;open thawed, read, write
OPENF
JRST [ POP P,A ;can't open it, release JFN
RLJFN ; ..
JFCL ;really can't, ignore.
JRST NOSTAT] ;and skip this
POP P,A ;get the JFN
MOVSI A,(A) ;page 0 of the file
MOVE B,[.S,,STATPG] ;statistics page in this fork
MOVSI C,140000 ;R/W access
PMAP ;make them equivalent
AOS SL.ONC ;count mapping in the page, about same
; as user first calling PAT
NOSTAT: ;end of statistics opener
>;IFN FTSTAT
TIME ;system uptime
MOVEM A,ITIME1 ;save for use in MSTIME
SETO 2,
MOVEI 4,0
ODCNV ;time of day in seconds
MOVEI A,(D) ; to A
IMULI A,↑D1000 ;in milliseconds
MOVEM A,ITIME2 ;save for mstime
MOVEM PF,PFLAGS ;stash PF in core on exit from ONCE
POPJ P, ;and return from once-only routine
;DEBUG SETCV
;DEBUG$G after loading sets up so system's PAT won't be loaded.
DEBUG: MOVE P,PATSTK ;set up a stack pointer
PUSHJ P,SETCV ;set compatibility vector
IFN LINKP,<
SETZM LINKS ;no links read yet
>;IFN LINKP
SETOM INPAT ;flag for UUO processor
MOVSI PF,L.DBUG ;set flag not to grab ↑C int
IORB PF,PFLAGS ;in core and AC flag words
PUSHJ P,ONCE ;set up temp storage and PSI sys
SETZM INPAT ;not processing in PAT now
JRST DDTLOC ;go to DDT
SETCV: MOVEI A,.S ;this fork
MOVE B,[XWD EVECL,EVEC] ;size and location of compat vector
MOVE C,[XWD MONUUO,MONUPC] ;place for monitor to stash UUO, PC
SCVEC ;set compatibility vector
POPJ P, ;return
;MAKEPF
;Produce <SUBSYS>'s share file of this code
MAKEPF: RESET ;clear the world
MOVE P,PATSTK ;need a stack here
PUSHJ P,CLRPSI ;make sure no leftover ints
MOVEI 1,400000
MOVE 2,[XWD EVECL,EVEC] ;EXEC will SCEVC from this EVEC
SEVEC ; when it brings in PA1050 on a UUO
MOVSI 1,(1B0+1B17) ;output+short form
HRROI 2,[ASCIZ /PA1050.SAV;A220100/]
GTJFN
PUSHJ P,ERROR
MOVEM A,JFNTAB ;preserve over typeout
HRROI A,[ASCIZ/Saved version /]
PSOUT
MOVEI A,101
MOVE B,PVLOC ;type version in octal
MOVEI C,10
NOUT ;on TTY
JFCL
HRROI A,[ASCIZ/ as file /]
PSOUT
MOVEI A,101
HRRZ B,JFNTAB
MOVE C,[211112,,110011]
JFNS ;type file name
MOVE A,JFNTAB
HRLI 1,400000 ;this fork,
HLRE 2,SJBSYM ;get length of symbol table
MOVNS 2 ;positive length
ADDI 2,ENDFF ;plus where they start is end of syms.
LSH 2,-11 ;beginning of that page
MOVNI 2,1(2) ;-<page after end>
MOVSI 2,PATPAG(2) ;(plus start is -length) to lh
MOVEI 3,PATLOC
LSH 3,-↑D9 ;first page
HRRI 2,120000(3) ;with read and execute allow bits
MOVEI C,0 ;documented to want 0 in c
SSAVE ;create share file
PUSHJ P,CRLF
HALTF
;GETSHR GSHR1 GSHR3 GSHR2
;Get 10/50 .SHR type file
GETSHR: RESET ;clear Tenex stuff
CALLI 0 ;'first' UUO
MOVE P,PATSTK
SETOM INPAT
HRROI 1,[ASCIZ /
Load SHR file from /]
PSOUT
MOVSI 1,120003
MOVE 2,[XWD 100,101]
GTJFN
PUSHJ P,ERROR
MOVE 2,[XWD 440000,200000]
OPENF
PUSHJ P,ERROR
MOVEI 7,400000 ;high segment address
GSHR1: BIN
JUMPN 2,GSHR3 ;if non-0, can't be end of file
GTSTS
TLNE 2,1000
JRST GSHR2
SETZ 2, ;not EOF, store the 0
GSHR3: MOVEM 2,0(7)
AOJA 7,GSHR1
GSHR2: CLOSF
PUSHJ P,ERROR
PUSHJ P,SETVES ;setup vestigal data
MOVEI 1,400000
HRRZ 2,.JBSA
HRLI 2,<JRST>B53 ;LH specifying 10/50 entry vector
SEVEC
SETZM INPAT
HALTF
;SETPSI SPSCTO ONCHNS ALLCHN CLRPSI
;Subroutine SETPSI to set up the pseudo interrupt system, and
; set for ↑O as an interrupt.
SETPSI: MOVEI A,.S ;this fork
DIR ;disable interrupt system
MOVE B,[XWD PSITAB,LEVTAB] ;copy pure tables to
SKIPN LEVTAB ; impure area, first time only.
BLT B,CHNTAB+↑D35 ;first time, copy it.
MOVE B,[XWD LEVTAB,CHNTAB] ;tell monitor where they are
SIR ; ..
SPSCTO: MOVSI A,17 ;and control O to
HRRI A,COPSIN ;its channel number
ATI ; ..
MOVEI A,.S ;this fork
MOVE B,ONCHNS ;channels always desired
MOVE C,USRENB ;those user may want
TRNE C,1B19 ;PDL Ov?
TLO B,(1B9) ;yes
TRNE C,1B23!1B22 ;Ill Mem Ref, Nxm?
TDO B,[EXP 1B16!1B17!1B18]
; TRNE C,1B26 ;clock flag
; TLO B,(1B14) ;time of day? *** not yet implemented
TRNE C,1B29 ;Fov?
TLO B,(1B7) ;yes
TRNE C,1B32 ;Ar Ov?
TLO B,(1B6) ;yes.
AIC ;turn on those channels
ANDCA B,ALLCHN ;turn off unselected ones from above
DIC ; ..
EIR ;and enable the interrupt system
POPJ P, ;return from SETPSI
ONCHNS: EXP <1B<COPSIN>>!<1B<CCPSIN>>!1B11!1B15!1B22 ;↑O, I/O, Ill opr, nxpage
;and mask of all that might want to be on
ALLCHN: EXP <1B<COPSIN>>!<1B<CCPSIN>>!1B6!1B7!1B9!1B11!1B14!1B15!7B18!1B22
CLRPSI: MOVEI A,.S ;this fork
CIS ;clear waiting ints
DIR ;disable int system
SETO B, ;all channels
DIC ;disable all channels
MOVEI A,.S ;this fork
SETZB C,B ;clear compatibility vector
SCVEC ;so will get new one after loading
;and not confuse non-1050 programs
POPJ P, ;and return from CLRPSI
;PSITAB COPSIN CCPSIN
PSITAB:
;LEVTAB
EXP RETSAV ;storage for channel 1 PC
EXP RETSAV+1 ;storage for channel 2 PC
EXP RETSAV+2 ;storage for channel 3 PC
;CHNTAB
0 ;channel 0
0 ;channel 1
0 ;channel 2
0 ;channel 3
0 ;channel 4
0 ;channel 5
XWD 1,OVINT ;overflow on channel 6
XWD 1,FOVINT ;floating overflow on channel 7
0 ;channel 8
XWD 1,PDLINT ;PDL overflow on channel 9
0 ;EOF on channel 10
XWD 1,IOERR ;I/O data error (11)
0 ;channel 12
0 ;channel 13
0 ;channel 14
XWD 1,INSINT ;illegal inst, ch 15
XWD 1,MEMINT ;channel 16 illegal read
XWD 1,MEMINT ;channel 17 illegal write
XWD 1,MEMINT ;channel 18 illegal execute
0 ;channel 19 subsidiary fork term
0 ;channel 20 machine size error
0 ;channel 21 trap to user
XWD 1,NXPINT ;chan 22, nonexistent page
0 ;channel 23
0 ;channel 24
0 ;channel 25
0 ;cahnnel 26
0 ;channel 27
0 ;channel 28
0 ;channel 29
COPSIN==.-PSITAB-3 ;channel for control O
XWD 1,CTOINT ;channel 30
CCPSIN==.-PSITAB-3 ;channel for REENTER handler
XWD 1,CSTART ;channel 31
0 ;channel 32
0 ;channel 33
0 ;channel 34
0 ;channel 35
IFN .-PSITAB-↑D36-↑D3,<PRINTX PSITAB Length wrong>
;MAKSHR MAKS2
;Create 10/50 SHR type file
MAKSHR: CALLI 0
MOVE P,PATSTK
SETOM INPAT
PUSHJ P,MAKVES ;copy job data area to vestigal area
MOVEI A,400000
UMOVE B,.JBSA
HRLI B,1
SEVEC ;setup entrr vector
MAKS2: HRROI A,[ASCIZ/
SSAVE on file /]
PSOUT
MOVSI A,460003
MOVE B,[XWD 100,101]
GTJFN
JRST MAKS2
HRLI A,400000
SETZ C,
MOVE B,[XWD -300,400+520B26]
SSAVE ;SSAVE pages 400 to 677 with
;read, execute, copy on write.
PUSHJ P,CLRPSI ;no PI's or compatibility vector
SETZM INPAT
HALTF
;CSTART CSTRUN CSTNIP
IFN SAMFRK,< ;this only written for same fork
CSTART:
SKIPN INPAT ;have AC's and stack?
JRST CSTNIP ;no, not in PAT.
PUSH P,A ;stash an AC
HRRZ A,CSTOPC ;where is the return to?
CAIE A,TTYBPC ;TTY input wait?
JRST CSTRUN ;no, running a UUO
MOVE A,PDL ;yes, get TTY UUO return.
SUBI A,1 ;point back at the UUO
MOVEM A,.JBOPC ;store for user
PUSHJ P,CSTADR ;find address of the START/etc
HRRZM A,RETSAV ;debreak to here
SETZM INPAT ;sneak out the back door of PAT
MOVSI 17,ACS ;get the user's AC's back
BLT 17,17 ; ..
DEBRK ;end of interrupt
CSTRUN: PUSHJ P,CSTADR ;get address to go to
HRROM A,CSTFLG ;store in flag for MRETN
POP P,A ;restore AC A
DEBRK ;end of interrupt
CSTNIP: MOVEM P,SEE ;save user AC P
MOVE P,PSISTK ;set up a stack
PUSH P,A ;and stash another AC
HRRZ A,RETSAV ;where were we?
CAIG A,ENDFF ;in PAT?
CAIGE A,PATLOC ; ..
SKIPA A,RETSAV ;no, debreak address to .JBOPC
MOVE A,MONUPC ;yes, in setup or exit, get call addr.
MOVEM A,.JBOPC ;store for user to see
PUSHJ P,CSTADR ;get place to go to
MOVEM A,RETSAV ;and make DEBRK go there
POP P,A ;restore AC's used
MOVE P,SEE ; ..
DEBRK ;and go to new address
;CSTADR CSTAD1 CSTADX
CSTADR: PUSH P,B
PUSH P,C
PUSHJ P,SETPSI ;in case not all channels on when
POP P,C ; user typed ↑C, get them back
POP P,B
SKIPL A,CSTCOD ;get the code from EXEC
JRST CSTAD1 ;positive is GOTO addr
MOVMS A ;make code positive
CAILE A,CSTMCD ;or out of range?
MOVEI A,0 ;yes, go straight to Tenex DDT
XCT [ MOVEI A,DDTLOC ;force DDT
HRRZ A,.JBSA ;START command
HRRZ A,.JBREN ;REENTER command
JRST [ HRRZ A,.JBDDT ;user's own DDT?
TRNN A,-1 ;anything there?
MOVEI A,DDTLOC ;no, use Tenex DDT
JRST CSTAD1]](A)
TRNN A,-1 ;an address available?
MOVEI A,CSTADX ;no.
CSTAD1: PUSH P,E ;this AC needs saving if on int lvl
PUSHJ P,NOCTRO ;clear control-O on mon-user xition
POP P,E ;restore AC E
POPJ P, ;return address in A
CSTADX: HRROI A,[ASCIZ/? No start address
/]
PSOUT
PUSHJ P,CLRPSI ;clear PSI and COMPAT vector
HALTF
PUSHJ P,SETCV ;if continued, put comp vec back
PUSHJ P,SETPSI ;and PSI system.
JRSTF @.JBOPC ;if he continues, go here.
>;IFN SAMFRK
;CPBOUT BAPOPJ APOPJ ERRARG ERRCHN BUGSTP ERROR ERROR1
;Utility and error routines
CPBOUT: PBOUT
BAPOPJ: POP P,B
APOPJ: POP P,A
POPJ P,
ERRARG: HRROI A,[ASCIZ/?
? UUO argument check/]
PSOUT
JRST ERROR2
ERRCHN: HRROI A,[ASCIZ\?
? I/O to unassigned channel\]
PSOUT
JRST ERROR2
BUGSTP: HRROI A,[ASCIZ/?
? Compatibility package deficiency encountered/]
PSOUT
JRST ERROR1
ERROR: HRLOI B,.S
SETZ C,
MOVEI A,101
ERSTR
JFCL
JFCL
ERROR1: HRROI A,[ASCIZ/ at PA1050 location /]
PSOUT
HRRZ B,(P)
SUBI B,1
MOVEI C,10
NOUT
JFCL
SETZ C,
; JRST ERROR2
;ERROR2 ITRAP ERRINT CSOUT CBOUT
ERROR2: SKIPA A,[-1,,[ASCIZ/ at user location /]]
ITRAP: HRROI A,[ASCIZ/?
? Illegal UUO at location /]
PSOUT
HRRZ 2,PDL
SUBI 2,1
MOVEI 3,↑D8
MOVEI 1,101
NOUT
JFCL
HRROI A,[ASCIZ/(instruction = /]
PSOUT
HRRZ 2,PDL
UMOVE 2,-1(2)
MOVEI 3,↑D8
MOVEI 1,PROJFN
NOUT
JFCL
HRROI A,[ASCIZ/)
/]
PSOUT
TRO PF,R.FERR ;flag error to prevent suicide
JRST EXIT2 ;restore acs and haltf
ERRINT: MOVEM A,IAC+1 ;an Ov, Fov, PDL, or MPV interrupt
MOVEM B,IAC+2 ; has happened inside compatibility
MOVEM C,IAC+3
MOVEI A,101
HRROI B,[ASCIZ/?
? Unexpected interrupt at PA1050 location /]
SETZ C,
CSOUT: SOUT
HRRZ B,RETSAV ;saved PC
MOVEI C,10 ;octal
NOUT
PUSHJ P,ERROR
MOVEI B,37
CBOUT: BOUT
MOVE A,IAC+1
MOVE B,IAC+2
MOVE C,IAC+3
DEBRK
HALTF
;MCALT NMCAL CALLIT NPCAL
;Call sixbit table here because rarely used.
DEFINE CC (A,B)
<
SIXBIT /A/ >
MCALT: ;table for CALL for neg CALLI's
MCALLI ;sixbit names of negative CALLs
NMCAL==.-MCALT ;number of minus CALLs
CALLIT:
DEFINE CC (A,B)<
IFLE .-CALLIT-MXSIXB,<
SIXBIT /A/
>>
PCALLI ;sixbit table of positive CALLI's
NPCAL==.-CALLIT ;number of positive CALLs
;ILEGAL SETUWP EXIT EXIT2 EXIT4
ILEGAL: PUSHJ P,ITRAP ;illegal UUO catcher
SETUWP: JRST MRETN2 ;skip return
EXIT: TRO PF,R.EXIT ;AC field nonzero?
JUMPN AC,EXIT2 ;if so, monret -- don't close files
TRZ PF,R.EXIT ;mark full EXIT
PUSHJ P,IRESET ;release if CALLI 12
SKIPN TMPJFN ;have TMPCOR file mapped?
JRST EXIT2 ;no
SETO A, ;yes, delete from map
MOVE B,[400000,,TMPCPG]
PMAP
MOVE A,TMPJFN ;close file
CLOSF
PUSHJ P,ERROR
SETZM TMPJFN ;mark no longer have TMPCOR file
EXIT2: MOVE A,PDL ;calling PC
MOVEM A,.JBPD1 ;to stack
MOVEM A,.JBOPC ;and to .JBOPC early, since will kill PAT.
HRRZ A,JBHRL ;is there a high seg?
CAILE A,.S ; ..
PUSHJ P,MAKVES ;yes, may be LOADER EXIT, make high vest
PUSHJ P,NOCTRO ;clear control O flag
MOVEI A,PRIJFN ;clear out the mode to reasonable.
RFMOD
TRZ B,77B23+3B25+3B29 ;fields of interest
TRO B,77B23+2B25+1B29 ;new values
SFMOD ;set them.
TRNE PF,R.EXIT ;EXIT or MONRT.?
JRST EXIT3 ;MONRT., don't say "Exit"
HRROI A,[ASCIZ/
Exit
/]
PSOUT
EXIT4: TRNE PF,R.FERR ;fatal error?
JRST EXIT3 ;yes, leave corpse for autopsy
PUSHJ P,CLRPSI ;clear all PSI activity
MOVE 0,ACS ;restore user AC 0
MOVEI A,SUICA-1 ;stash some AC's
PUSH A,ACS+A ;in low core
PUSH A,ACS+B
PUSH A,ACS+C
SETZM INPAT ;note that no longer have a stack
MOVE A,[XWD ACS+D,D] ;restore rest of user's AC's
BLT A,17 ; ..
MOVE A,[XWD KSUIC,SUICID] ;move the suicide code to low core
BLT A,ESUIC ; ..
MOVSI B,.S ;this fork for pmap
SETO A, ;to nonexistence
MOVSI C,-NPATPG ;loop control
JRST SUICID ;and go delete PA1050 from map
;EXIT3 EXIT1 KSUIC SUICID ESUIC SUICA SUICB SUICC SETNAM
EXIT3: PUSH P,[EXIT1] ;address of HALTF instruction
JRST MRETN ;restore AC's and halt
EXIT1: HALTF
MOVEM P,ACS+17
MOVEI P,ACS
BLT P,ACS+16
MOVE P,PATSTK
PUSH P,1(P)
HLLZ PF,PFLAGS
SETOM INPAT ; this is correct (MRETN) except for loc. 45
PUSHJ P,SETCV ;set compatibility vector
PUSHJ P,SETPSI ;if continued
JRST MRETN ;if continued
KSUIC: ;code for suicide of pat
PHASE 20 ;where to move it to
SUICID: HRRI B,PATPAG(C) ;page of this fork to flush
PMAP ;do it.
AOBJN C,SUICID ;for all of PAT
MOVE A,SUICA ;restore last 3 ACs
MOVE B,SUICB
MOVE C,SUICC
HALTF
JRST .-1
ESUIC==.-1
SUICA: BLOCK 1
SUICB: BLOCK 1
SUICC: BLOCK 1
DEPHASE
SETNAM: MOVE A,CAC ;sixbit name of user program
SETNM
JRST MRETN
;LIN2 LIN3 FFF0 FFF ENDFF
;After-loading fixup
LIN2: MOVE P,PATSTK ;get a stack
PUSHJ P,CLRPSI ;clear compat vector and PSI system
SETO 1,
MOVSI 2,400000
LIN3: PMAP ;flush everything not in PAT
MOVEI 4,0(2)
CAIGE 4,PATPAG-1
AOJA 2,LIN3
HALTF
XLIST ;literals
LIT ;high core literals
LIST
FFF0:
FFF: BLOCK 100 ;patch space
ENDFF: ;end of everything, used by makepf, linit
IFN SAMFRK,<
LOC 140 ;in low segment for fixups
>;IFN SAMFRK
;LINIT LIN0 LIN1
;Start here after loading
LINIT:! RESET ;turn off PI system
MOVEI A,.S ;clobber the PSI system
DIR ; disable system
CIS ;clear anything pending
SETO B, ;all ones
DIC ;disable all channels
MOVE A,[JRST COMPAT] ;should be first word of program
CAMN A,KEVEC-PATLOC+LODORG ;is it?
JRST LIN0 ;yes. ok.
HRROI A,[ASCIZ /? Loading error
/]
PSOUT ;someone has changed the LOADER!
HALTF
LIN0:! MOVEI B,PATPAG ;page where PAT lives
HRLI B,400000
SETO A,
LIN1:! PMAP ;clear area to put code
ADDI B,1
TRNN B,1000
JRST LIN1
MOVE A,[XWD LODORG,PATLOC] ;ready to BLT the code
BLT A,ENDFF ;where it should end
MOVE A,[KEVEC,,EVEC] ;move literal vector to running vector
MOVEI B,EVECL(A) ;end of running vector
BLT A,-1(B) ;seems to be only way to get to 700000.
HLRE A,.JBSYM ;-length of sym tab
MOVMS A ;+ length of sym tab
HRLZ B,.JBSYM ;where symtab now starts
HRRI B,ENDFF ;where it will start
HRRM B,.JBSYM ;update .JBSYM itself
BLT B,ENDFF(A) ;move the symbols
MOVSI 1,(1B2+1B17)
HRROI 2,[ASCIZ /<SUBSYS>UDDT.SAV/]
GTJFN
JRST 4,.-1
HRLI 1,400000
GET ;get DDT
MOVE 1,.JBSYM
MOVEM 1,@DDTLOC+1 ;setup DDT symtab ptr
MOVEM 1,SJBSYM ;store at entry vector+delta too
JRST LIN2 ;complete fixup in high core
XLIST ;literals
LIT
LIST
END LINIT